git diff --src-prefix=a/src/ --dst-prefix=b/src/ master..a68 | grep -E -v '^(diff|index|new)'
git diff --src-prefix=a/src/ --dst-prefix=b/src/ gcc-15..gcc-15-a68 | grep -E -v '^(diff|index|new)'

--- a/src/MAINTAINERS
+++ b/src/MAINTAINERS
@@ -173,6 +173,7 @@ objective-c/c++         Mike Stump              <mikestump@comcast.net>
 objective-c/c++         Iain Sandoe             <iain@sandoe.co.uk>
 Rust                    Arthur Cohen            <arthur.cohen@embecosm.com>
 Rust                    Philip Herron           <herron.philip@googlemail.com>
+Algol 68                Jose E. Marchesi        <jemarch@gnu.org>
 
                         Various Maintainers
 
@@ -181,6 +182,7 @@ libcpp                  Per Bothner             <per@bothner.com>
 libcpp                  All C and C++ front end maintainers
 libcpp                  David Malcolm           <dmalcolm@redhat.com>
 fp-bit                  Ian Lance Taylor        <ian@airs.com>
+libga68                 Jose E. Marchesi        <jemarch@gnu.org>
 libgcc                  Ian Lance Taylor        <ian@airs.com>
 libgo                   Ian Lance Taylor        <ian@airs.com>
 libgomp                 Jakub Jelinek           <jakub@redhat.com>
--- a/src/Makefile.def
+++ b/src/Makefile.def
@@ -205,6 +205,7 @@ target_modules = { module= zlib; bootstrap=true; };
 target_modules = { module= rda; };
 target_modules = { module= libada; };
 target_modules = { module= libgm2; lib_path=.libs; };
+target_modules = { module= libga68; 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; };
@@ -676,6 +677,7 @@ dependencies = { module=configure-target-libstdc++-v3; on=configure-target-libgo
 dependencies = { module=configure-target-libsanitizer; on=all-target-libstdc++-v3; };
 dependencies = { module=configure-target-libvtv; on=all-target-libstdc++-v3; };
 dependencies = { module=configure-target-libgrust; on=all-target-libstdc++-v3; };
+dependencies = { module=configure-target-libga68; on=all-target-libstdc++-v3; };
 // parallel_list.o and parallel_settings.o depend on omp.h, which is
 // generated by the libgomp configure.  Unfortunately, due to the use of
 //  recursive make, we can't be that specific.
@@ -734,6 +736,8 @@ languages = { language=jit;	gcc-check-target=check-jit; };
 languages = { language=rust;	gcc-check-target=check-rust; };
 languages = { language=cobol;	gcc-check-target=check-cobol;
 				lib-check-target=check-target-libgcobol; };
+languages = { language=algol68; gcc-check-target=check-algol68;
+          			lib-check-target=check-target-libga68; };
 
 // Toplevel bootstrap
 bootstrap_stage = { id=1 ; };
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -276,6 +276,11 @@ POSTSTAGE1_HOST_EXPORTS = \
 	CC_FOR_BUILD="$$CC"; export CC_FOR_BUILD; \
 	$(POSTSTAGE1_CXX_EXPORT) \
 	$(LTO_EXPORTS) \
+	GA68="$$r/$(HOST_SUBDIR)/prev-gcc/ga68$(exeext) -B$$r/$(HOST_SUBDIR)/prev-gcc/ \
+	  -B$(build_tooldir)/bin/ $(GA68FLAGS_FOR_TARGET) \
+	  -B$$r/prev-$(TARGET_SUBDIR)/libga68/.libs"; \
+	export GA68; \
+	GA68_FOR_BUILD="$$GA68"; export GA68_FOR_BUILD; \
 	GDC="$$r/$(HOST_SUBDIR)/prev-gcc/gdc$(exeext) -B$$r/$(HOST_SUBDIR)/prev-gcc/ \
 	  -B$(build_tooldir)/bin/ $(GDCFLAGS_FOR_TARGET) \
 	  -B$$r/prev-$(TARGET_SUBDIR)/libphobos/libdruntime/gcc \
@@ -308,6 +313,7 @@ BASE_TARGET_EXPORTS = \
 	CPPFLAGS="$(CPPFLAGS_FOR_TARGET)"; export CPPFLAGS; \
 	CXXFLAGS="$(CXXFLAGS_FOR_TARGET)"; export CXXFLAGS; \
 	GFORTRAN="$(GFORTRAN_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GFORTRAN; \
+	GA68="$(GA68_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GA68; \
 	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; \
@@ -377,6 +383,7 @@ CXX_FOR_BUILD = @CXX_FOR_BUILD@
 DLLTOOL_FOR_BUILD = @DLLTOOL_FOR_BUILD@
 DSYMUTIL_FOR_BUILD = @DSYMUTIL_FOR_BUILD@
 GFORTRAN_FOR_BUILD = @GFORTRAN_FOR_BUILD@
+GA68_FOR_BUILD = @GA68_FOR_BUILD@
 GOC_FOR_BUILD = @GOC_FOR_BUILD@
 GDC_FOR_BUILD = @GDC_FOR_BUILD@
 GM2_FOR_BUILD = @GM2_FOR_BUILD@
@@ -439,6 +446,7 @@ STRIP = @STRIP@
 WINDRES = @WINDRES@
 WINDMC = @WINDMC@
 
+GA68 = @GA68@
 GDC = @GDC@
 GNATBIND = @GNATBIND@
 GNATMAKE = @GNATMAKE@
@@ -449,6 +457,7 @@ LIBCFLAGS = $(CFLAGS)
 CXXFLAGS = @CXXFLAGS@
 LIBCXXFLAGS = $(CXXFLAGS) -fno-implicit-templates
 GOCFLAGS = $(CFLAGS)
+GA68FLAGS = @GA68FLAGS@
 GDCFLAGS = @GDCFLAGS@
 GM2FLAGS = $(CFLAGS)
 
@@ -676,6 +685,7 @@ CXX_FOR_TARGET=$(STAGE_CC_WRAPPER) @CXX_FOR_TARGET@
 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@
+GA68_FOR_TARGET=$(STAGE_CC_WRAPPER) @GA68_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@
@@ -705,6 +715,7 @@ 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
+GA68FLAGS_FOR_TARGET = -O2 -g
 GDCFLAGS_FOR_TARGET = -O2 -g
 
 FLAGS_FOR_TARGET = @FLAGS_FOR_TARGET@
@@ -730,7 +741,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_libgm2)$(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_libga68)$(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:
@@ -756,6 +767,10 @@ TARGET_LIB_PATH_libphobos = $$r/$(TARGET_SUBDIR)/libphobos/src/.libs:
 TARGET_LIB_PATH_libgm2 = $$r/$(TARGET_SUBDIR)/libgm2/.libs:
 @endif target-libgm2
 
+@if target-libga68
+TARGET_LIB_PATH_libga68 = $$r/$(TARGET_SUBDIR)/libga68/.libs:
+@endif target-libga68
+
 @if target-libgomp
 TARGET_LIB_PATH_libgomp = $$r/$(TARGET_SUBDIR)/libgomp/.libs:
 @endif target-libgomp
@@ -976,6 +991,7 @@ EXTRA_HOST_FLAGS = \
 	'DSYMUTIL=$(DSYMUTIL)' \
 	'GFORTRAN=$(GFORTRAN)' \
 	'GOC=$(GOC)' \
+	'GA68=$(GA68)' \
 	'GDC=$(GDC)' \
 	'GM2=$(GM2)' \
 	'LD=$(LD)' \
@@ -1004,6 +1020,7 @@ STAGE1_FLAGS_TO_PASS = \
 POSTSTAGE1_FLAGS_TO_PASS = \
 	CC="$${CC}" CC_FOR_BUILD="$${CC_FOR_BUILD}" \
 	CXX="$${CXX}" CXX_FOR_BUILD="$${CXX_FOR_BUILD}" \
+	GA68="$${GA68}" GA68_FOR_BUILD="$${GA68_FOR_BUILD}" \
 	GDC="$${GDC}" GDC_FOR_BUILD="$${GDC_FOR_BUILD}" \
 	GM2="$${GM2}" GM2_FOR_BUILD="$${GM2_FOR_BUILD}" \
 	GNATBIND="$${GNATBIND}" \
@@ -1039,6 +1056,7 @@ EXTRA_TARGET_FLAGS = \
 	'GFORTRAN=$$(GFORTRAN_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
 	'GOC=$$(GOC_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
 	'GOCFLAGS=$$(GOCFLAGS_FOR_TARGET)' \
+	'GA68=$$(GA68_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
 	'GDC=$$(GDC_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
 	'GDCFLAGS=$$(GDCFLAGS_FOR_TARGET)' \
 	'GM2=$$(GM2_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
@@ -1160,6 +1178,7 @@ configure-target:  \
     maybe-configure-target-rda \
     maybe-configure-target-libada \
     maybe-configure-target-libgm2 \
+    maybe-configure-target-libga68 \
     maybe-configure-target-libgomp \
     maybe-configure-target-libitm \
     maybe-configure-target-libatomic \
@@ -1360,6 +1379,7 @@ all-target: maybe-all-target-zlib
 all-target: maybe-all-target-rda
 all-target: maybe-all-target-libada
 all-target: maybe-all-target-libgm2
+all-target: maybe-all-target-libga68
 @if target-libgomp-no-bootstrap
 all-target: maybe-all-target-libgomp
 @endif target-libgomp-no-bootstrap
@@ -1463,6 +1483,7 @@ 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-libga68
 info-target: maybe-info-target-libgomp
 info-target: maybe-info-target-libitm
 info-target: maybe-info-target-libatomic
@@ -1557,6 +1578,7 @@ 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-libga68
 dvi-target: maybe-dvi-target-libgomp
 dvi-target: maybe-dvi-target-libitm
 dvi-target: maybe-dvi-target-libatomic
@@ -1651,6 +1673,7 @@ 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-libga68
 pdf-target: maybe-pdf-target-libgomp
 pdf-target: maybe-pdf-target-libitm
 pdf-target: maybe-pdf-target-libatomic
@@ -1745,6 +1768,7 @@ 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-libga68
 html-target: maybe-html-target-libgomp
 html-target: maybe-html-target-libitm
 html-target: maybe-html-target-libatomic
@@ -1839,6 +1863,7 @@ 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-libga68
 TAGS-target: maybe-TAGS-target-libgomp
 TAGS-target: maybe-TAGS-target-libitm
 TAGS-target: maybe-TAGS-target-libatomic
@@ -1933,6 +1958,7 @@ 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-libga68
 install-info-target: maybe-install-info-target-libgomp
 install-info-target: maybe-install-info-target-libitm
 install-info-target: maybe-install-info-target-libatomic
@@ -2027,6 +2053,7 @@ 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-libga68
 install-dvi-target: maybe-install-dvi-target-libgomp
 install-dvi-target: maybe-install-dvi-target-libitm
 install-dvi-target: maybe-install-dvi-target-libatomic
@@ -2121,6 +2148,7 @@ 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-libga68
 install-pdf-target: maybe-install-pdf-target-libgomp
 install-pdf-target: maybe-install-pdf-target-libitm
 install-pdf-target: maybe-install-pdf-target-libatomic
@@ -2215,6 +2243,7 @@ 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-libga68
 install-html-target: maybe-install-html-target-libgomp
 install-html-target: maybe-install-html-target-libitm
 install-html-target: maybe-install-html-target-libatomic
@@ -2309,6 +2338,7 @@ 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-libga68
 installcheck-target: maybe-installcheck-target-libgomp
 installcheck-target: maybe-installcheck-target-libitm
 installcheck-target: maybe-installcheck-target-libatomic
@@ -2403,6 +2433,7 @@ 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-libga68
 mostlyclean-target: maybe-mostlyclean-target-libgomp
 mostlyclean-target: maybe-mostlyclean-target-libitm
 mostlyclean-target: maybe-mostlyclean-target-libatomic
@@ -2497,6 +2528,7 @@ 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-libga68
 clean-target: maybe-clean-target-libgomp
 clean-target: maybe-clean-target-libitm
 clean-target: maybe-clean-target-libatomic
@@ -2591,6 +2623,7 @@ 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-libga68
 distclean-target: maybe-distclean-target-libgomp
 distclean-target: maybe-distclean-target-libitm
 distclean-target: maybe-distclean-target-libatomic
@@ -2685,6 +2718,7 @@ 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-libga68
 maintainer-clean-target: maybe-maintainer-clean-target-libgomp
 maintainer-clean-target: maybe-maintainer-clean-target-libitm
 maintainer-clean-target: maybe-maintainer-clean-target-libatomic
@@ -2837,6 +2871,7 @@ check-target:  \
     maybe-check-target-rda \
     maybe-check-target-libada \
     maybe-check-target-libgm2 \
+    maybe-check-target-libga68 \
     maybe-check-target-libgomp \
     maybe-check-target-libitm \
     maybe-check-target-libatomic \
@@ -3035,6 +3070,7 @@ install-target:  \
     maybe-install-target-rda \
     maybe-install-target-libada \
     maybe-install-target-libgm2 \
+    maybe-install-target-libga68 \
     maybe-install-target-libgomp \
     maybe-install-target-libitm \
     maybe-install-target-libatomic \
@@ -3149,6 +3185,7 @@ install-strip-target:  \
     maybe-install-strip-target-rda \
     maybe-install-strip-target-libada \
     maybe-install-strip-target-libgm2 \
+    maybe-install-strip-target-libga68 \
     maybe-install-strip-target-libgomp \
     maybe-install-strip-target-libitm \
     maybe-install-strip-target-libatomic \
@@ -60200,6 +60237,491 @@ maintainer-clean-target-libgm2:
 
 
 
+.PHONY: configure-target-libga68 maybe-configure-target-libga68
+maybe-configure-target-libga68:
+@if gcc-bootstrap
+configure-target-libga68: stage_current
+@endif gcc-bootstrap
+@if target-libga68
+maybe-configure-target-libga68: configure-target-libga68
+configure-target-libga68: 
+	@: $(MAKE); $(unstage)
+	@r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	echo "Checking multilib configuration for libga68..."; \
+	$(SHELL) $(srcdir)/mkinstalldirs $(TARGET_SUBDIR)/libga68; \
+	$(CC_FOR_TARGET) --print-multi-lib > $(TARGET_SUBDIR)/libga68/multilib.tmp 2> /dev/null; \
+	if test -r $(TARGET_SUBDIR)/libga68/multilib.out; then \
+	  if cmp -s $(TARGET_SUBDIR)/libga68/multilib.tmp $(TARGET_SUBDIR)/libga68/multilib.out; then \
+	    rm -f $(TARGET_SUBDIR)/libga68/multilib.tmp; \
+	  else \
+	    rm -f $(TARGET_SUBDIR)/libga68/Makefile; \
+	    mv $(TARGET_SUBDIR)/libga68/multilib.tmp $(TARGET_SUBDIR)/libga68/multilib.out; \
+	  fi; \
+	else \
+	  mv $(TARGET_SUBDIR)/libga68/multilib.tmp $(TARGET_SUBDIR)/libga68/multilib.out; \
+	fi; \
+	test ! -f $(TARGET_SUBDIR)/libga68/Makefile || exit 0; \
+	$(SHELL) $(srcdir)/mkinstalldirs $(TARGET_SUBDIR)/libga68; \
+	$(NORMAL_TARGET_EXPORTS)  \
+	echo Configuring in $(TARGET_SUBDIR)/libga68; \
+	cd "$(TARGET_SUBDIR)/libga68" || exit 1; \
+	case $(srcdir) in \
+	  /* | [A-Za-z]:[\\/]*) topdir=$(srcdir) ;; \
+	  *) topdir=`echo $(TARGET_SUBDIR)/libga68/ | \
+		sed -e 's,\./,,g' -e 's,[^/]*/,../,g' `$(srcdir) ;; \
+	esac; \
+	module_srcdir=libga68; \
+	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-libga68
+
+
+
+
+
+.PHONY: all-target-libga68 maybe-all-target-libga68
+maybe-all-target-libga68:
+@if gcc-bootstrap
+all-target-libga68: stage_current
+@endif gcc-bootstrap
+@if target-libga68
+TARGET-target-libga68=all
+maybe-all-target-libga68: all-target-libga68
+all-target-libga68: configure-target-libga68
+	@: $(MAKE); $(unstage)
+	@r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS)  \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(MAKE) $(BASE_FLAGS_TO_PASS) $(EXTRA_TARGET_FLAGS)   \
+		$(TARGET-target-libga68))
+@endif target-libga68
+
+
+
+
+
+.PHONY: check-target-libga68 maybe-check-target-libga68
+maybe-check-target-libga68:
+@if target-libga68
+maybe-check-target-libga68: check-target-libga68
+
+check-target-libga68:
+	@: $(MAKE); $(unstage)
+	@r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(MAKE) $(TARGET_FLAGS_TO_PASS)   check)
+
+@endif target-libga68
+
+.PHONY: install-target-libga68 maybe-install-target-libga68
+maybe-install-target-libga68:
+@if target-libga68
+maybe-install-target-libga68: install-target-libga68
+
+install-target-libga68: installdirs
+	@: $(MAKE); $(unstage)
+	@r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(MAKE) $(TARGET_FLAGS_TO_PASS)  install)
+
+@endif target-libga68
+
+.PHONY: install-strip-target-libga68 maybe-install-strip-target-libga68
+maybe-install-strip-target-libga68:
+@if target-libga68
+maybe-install-strip-target-libga68: install-strip-target-libga68
+
+install-strip-target-libga68: installdirs
+	@: $(MAKE); $(unstage)
+	@r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(MAKE) $(TARGET_FLAGS_TO_PASS)  install-strip)
+
+@endif target-libga68
+
+# Other targets (info, dvi, pdf, etc.)
+
+.PHONY: maybe-info-target-libga68 info-target-libga68
+maybe-info-target-libga68:
+@if target-libga68
+maybe-info-target-libga68: info-target-libga68
+
+info-target-libga68: \
+    configure-target-libga68 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing info in $(TARGET_SUBDIR)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+.PHONY: maybe-dvi-target-libga68 dvi-target-libga68
+maybe-dvi-target-libga68:
+@if target-libga68
+maybe-dvi-target-libga68: dvi-target-libga68
+
+dvi-target-libga68: \
+    configure-target-libga68 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing dvi in $(TARGET_SUBDIR)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+.PHONY: maybe-pdf-target-libga68 pdf-target-libga68
+maybe-pdf-target-libga68:
+@if target-libga68
+maybe-pdf-target-libga68: pdf-target-libga68
+
+pdf-target-libga68: \
+    configure-target-libga68 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing pdf in $(TARGET_SUBDIR)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+.PHONY: maybe-html-target-libga68 html-target-libga68
+maybe-html-target-libga68:
+@if target-libga68
+maybe-html-target-libga68: html-target-libga68
+
+html-target-libga68: \
+    configure-target-libga68 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing html in $(TARGET_SUBDIR)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+.PHONY: maybe-TAGS-target-libga68 TAGS-target-libga68
+maybe-TAGS-target-libga68:
+@if target-libga68
+maybe-TAGS-target-libga68: TAGS-target-libga68
+
+TAGS-target-libga68: \
+    configure-target-libga68 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing TAGS in $(TARGET_SUBDIR)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+.PHONY: maybe-install-info-target-libga68 install-info-target-libga68
+maybe-install-info-target-libga68:
+@if target-libga68
+maybe-install-info-target-libga68: install-info-target-libga68
+
+install-info-target-libga68: \
+    configure-target-libga68 \
+    info-target-libga68 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/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)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+.PHONY: maybe-install-dvi-target-libga68 install-dvi-target-libga68
+maybe-install-dvi-target-libga68:
+@if target-libga68
+maybe-install-dvi-target-libga68: install-dvi-target-libga68
+
+install-dvi-target-libga68: \
+    configure-target-libga68 \
+    dvi-target-libga68 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/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)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+.PHONY: maybe-install-pdf-target-libga68 install-pdf-target-libga68
+maybe-install-pdf-target-libga68:
+@if target-libga68
+maybe-install-pdf-target-libga68: install-pdf-target-libga68
+
+install-pdf-target-libga68: \
+    configure-target-libga68 \
+    pdf-target-libga68 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/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)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+.PHONY: maybe-install-html-target-libga68 install-html-target-libga68
+maybe-install-html-target-libga68:
+@if target-libga68
+maybe-install-html-target-libga68: install-html-target-libga68
+
+install-html-target-libga68: \
+    configure-target-libga68 \
+    html-target-libga68 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/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)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+.PHONY: maybe-installcheck-target-libga68 installcheck-target-libga68
+maybe-installcheck-target-libga68:
+@if target-libga68
+maybe-installcheck-target-libga68: installcheck-target-libga68
+
+installcheck-target-libga68: \
+    configure-target-libga68 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing installcheck in $(TARGET_SUBDIR)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+.PHONY: maybe-mostlyclean-target-libga68 mostlyclean-target-libga68
+maybe-mostlyclean-target-libga68:
+@if target-libga68
+maybe-mostlyclean-target-libga68: mostlyclean-target-libga68
+
+mostlyclean-target-libga68: 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing mostlyclean in $(TARGET_SUBDIR)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+.PHONY: maybe-clean-target-libga68 clean-target-libga68
+maybe-clean-target-libga68:
+@if target-libga68
+maybe-clean-target-libga68: clean-target-libga68
+
+clean-target-libga68: 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing clean in $(TARGET_SUBDIR)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+.PHONY: maybe-distclean-target-libga68 distclean-target-libga68
+maybe-distclean-target-libga68:
+@if target-libga68
+maybe-distclean-target-libga68: distclean-target-libga68
+
+distclean-target-libga68: 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(NORMAL_TARGET_EXPORTS) \
+	echo "Doing distclean in $(TARGET_SUBDIR)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+.PHONY: maybe-maintainer-clean-target-libga68 maintainer-clean-target-libga68
+maybe-maintainer-clean-target-libga68:
+@if target-libga68
+maybe-maintainer-clean-target-libga68: maintainer-clean-target-libga68
+
+maintainer-clean-target-libga68: 
+	@: $(MAKE); $(unstage)
+	@[ -f $(TARGET_SUBDIR)/libga68/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)/libga68"; \
+	for flag in $(EXTRA_TARGET_FLAGS); do \
+	  eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \
+	done; \
+	(cd $(TARGET_SUBDIR)/libga68 && \
+	  $(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-libga68
+
+
+
+
+
 .PHONY: configure-target-libgomp maybe-configure-target-libgomp
 maybe-configure-target-libgomp:
 @if gcc-bootstrap
@@ -64333,7 +64855,15 @@ check-gcc-cobol: gcc-site.exp
 	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
 	$(HOST_EXPORTS) \
 	(cd gcc && $(MAKE) $(GCC_FLAGS_TO_PASS) check-cobol);
+
 check-cobol: check-gcc-cobol check-target-libgcobol
+.PHONY: check-gcc-algol68 check-algol68
+check-gcc-algol68: gcc-site.exp
+	r=`${PWD_COMMAND}`; export r; \
+	s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \
+	$(HOST_EXPORTS) \
+	(cd gcc && $(MAKE) $(GCC_FLAGS_TO_PASS) check-algol68);
+check-algol68: check-gcc-algol68 check-target-libga68
 
 
 # The gcc part of install-no-fixedincludes, which relies on an intimate
@@ -67876,6 +68406,7 @@ configure-stageautofeedback-target-zlib: maybe-all-stageautofeedback-gcc
 configure-target-rda: stage_last
 configure-target-libada: stage_last
 configure-target-libgm2: stage_last
+configure-target-libga68: 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
@@ -67920,6 +68451,7 @@ 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-libga68: maybe-all-gcc
 configure-target-libgomp: maybe-all-gcc
 configure-target-libitm: maybe-all-gcc
 configure-target-libatomic: maybe-all-gcc
@@ -69220,6 +69752,9 @@ all-target-libgm2: maybe-all-target-libatomic
 @unless target-libstdc++-v3-bootstrap
 configure-target-libgrust: maybe-all-target-libstdc++-v3
 @endunless target-libstdc++-v3-bootstrap
+@unless target-libstdc++-v3-bootstrap
+configure-target-libga68: maybe-all-target-libstdc++-v3
+@endunless target-libstdc++-v3-bootstrap
 @unless target-libbacktrace-bootstrap
 configure-target-libgfortran: maybe-all-target-libbacktrace
 @endunless target-libbacktrace-bootstrap
@@ -69281,6 +69816,7 @@ all-target-libgo: maybe-all-target-libatomic
 configure-target-libgm2: maybe-all-target-libstdc++-v3
 all-target-libgm2: maybe-all-target-libatomic
 configure-target-libgrust: maybe-all-target-libstdc++-v3
+configure-target-libga68: maybe-all-target-libstdc++-v3
 configure-target-newlib: maybe-all-binutils
 configure-target-newlib: maybe-all-ld
 configure-target-libgfortran: maybe-all-target-libbacktrace
@@ -69387,6 +69923,7 @@ 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-libga68: 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
@@ -69433,6 +69970,8 @@ configure-target-libada: maybe-all-target-newlib maybe-all-target-libgloss
 
 configure-target-libgm2: maybe-all-target-newlib maybe-all-target-libgloss
 
+configure-target-libga68: 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
--- a/src/Makefile.tpl
+++ b/src/Makefile.tpl
@@ -279,6 +279,11 @@ POSTSTAGE1_HOST_EXPORTS = \
 	CC_FOR_BUILD="$$CC"; export CC_FOR_BUILD; \
 	$(POSTSTAGE1_CXX_EXPORT) \
 	$(LTO_EXPORTS) \
+	GA68="$$r/$(HOST_SUBDIR)/prev-gcc/ga68$(exeext) -B$$r/$(HOST_SUBDIR)/prev-gcc/ \
+	  -B$(build_tooldir)/bin/ $(GA68FLAGS_FOR_TARGET) \
+	  -B$$r/prev-$(TARGET_SUBDIR)/libga68/.libs"; \
+	export GA68; \
+	GA68_FOR_BUILD="$$GA68"; export GA68_FOR_BUILD; \
 	GDC="$$r/$(HOST_SUBDIR)/prev-gcc/gdc$(exeext) -B$$r/$(HOST_SUBDIR)/prev-gcc/ \
 	  -B$(build_tooldir)/bin/ $(GDCFLAGS_FOR_TARGET) \
 	  -B$$r/prev-$(TARGET_SUBDIR)/libphobos/libdruntime/gcc \
@@ -311,6 +316,7 @@ BASE_TARGET_EXPORTS = \
 	CPPFLAGS="$(CPPFLAGS_FOR_TARGET)"; export CPPFLAGS; \
 	CXXFLAGS="$(CXXFLAGS_FOR_TARGET)"; export CXXFLAGS; \
 	GFORTRAN="$(GFORTRAN_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GFORTRAN; \
+	GA68="$(GA68_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GA68; \
 	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; \
@@ -380,6 +386,7 @@ CXX_FOR_BUILD = @CXX_FOR_BUILD@
 DLLTOOL_FOR_BUILD = @DLLTOOL_FOR_BUILD@
 DSYMUTIL_FOR_BUILD = @DSYMUTIL_FOR_BUILD@
 GFORTRAN_FOR_BUILD = @GFORTRAN_FOR_BUILD@
+GA68_FOR_BUILD = @GA68_FOR_BUILD@
 GOC_FOR_BUILD = @GOC_FOR_BUILD@
 GDC_FOR_BUILD = @GDC_FOR_BUILD@
 GM2_FOR_BUILD = @GM2_FOR_BUILD@
@@ -442,6 +449,7 @@ STRIP = @STRIP@
 WINDRES = @WINDRES@
 WINDMC = @WINDMC@
 
+GA68 = @GA68@
 GDC = @GDC@
 GNATBIND = @GNATBIND@
 GNATMAKE = @GNATMAKE@
@@ -452,6 +460,7 @@ LIBCFLAGS = $(CFLAGS)
 CXXFLAGS = @CXXFLAGS@
 LIBCXXFLAGS = $(CXXFLAGS) -fno-implicit-templates
 GOCFLAGS = $(CFLAGS)
+GA68FLAGS = @GA68FLAGS@
 GDCFLAGS = @GDCFLAGS@
 GM2FLAGS = $(CFLAGS)
 
@@ -599,6 +608,7 @@ CXX_FOR_TARGET=$(STAGE_CC_WRAPPER) @CXX_FOR_TARGET@
 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@
+GA68_FOR_TARGET=$(STAGE_CC_WRAPPER) @GA68_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@
@@ -628,6 +638,7 @@ 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
+GA68FLAGS_FOR_TARGET = -O2 -g
 GDCFLAGS_FOR_TARGET = -O2 -g
 
 FLAGS_FOR_TARGET = @FLAGS_FOR_TARGET@
@@ -732,6 +743,7 @@ EXTRA_HOST_FLAGS = \
 	'DSYMUTIL=$(DSYMUTIL)' \
 	'GFORTRAN=$(GFORTRAN)' \
 	'GOC=$(GOC)' \
+	'GA68=$(GA68)' \
 	'GDC=$(GDC)' \
 	'GM2=$(GM2)' \
 	'LD=$(LD)' \
@@ -760,6 +772,7 @@ STAGE1_FLAGS_TO_PASS = \
 POSTSTAGE1_FLAGS_TO_PASS = \
 	CC="$${CC}" CC_FOR_BUILD="$${CC_FOR_BUILD}" \
 	CXX="$${CXX}" CXX_FOR_BUILD="$${CXX_FOR_BUILD}" \
+	GA68="$${GA68}" GA68_FOR_BUILD="$${GA68_FOR_BUILD}" \
 	GDC="$${GDC}" GDC_FOR_BUILD="$${GDC_FOR_BUILD}" \
 	GM2="$${GM2}" GM2_FOR_BUILD="$${GM2_FOR_BUILD}" \
 	GNATBIND="$${GNATBIND}" \
@@ -795,6 +808,7 @@ EXTRA_TARGET_FLAGS = \
 	'GFORTRAN=$$(GFORTRAN_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
 	'GOC=$$(GOC_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
 	'GOCFLAGS=$$(GOCFLAGS_FOR_TARGET)' \
+	'GA68=$$(GA68_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
 	'GDC=$$(GDC_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
 	'GDCFLAGS=$$(GDCFLAGS_FOR_TARGET)' \
 	'GM2=$$(GM2_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \
--- a/src/SECURITY.txt
+++ b/src/SECURITY.txt
@@ -85,6 +85,7 @@ Language runtime libraries
     * libcpp
     * libdecnumber
     * libffi
+    * liga68
     * libgcc
     * libgfortran
     * libgm2
--- a/src/config/acx.m4
+++ b/src/config/acx.m4
@@ -434,6 +434,12 @@ else
   have_cargo=no
 fi])
 
+# Test for Algol 68
+AC_DEFUN([ACX_PROG_GA68],
+[AC_REQUIRE([AC_CHECK_TOOL_PREFIX])
+AC_REQUIRE([AC_PROG_CC])
+AC_CHECK_TOOL(GA68, ga68, no)])
+
 # Test for D.
 AC_DEFUN([ACX_PROG_GDC],
 [AC_REQUIRE([AC_CHECK_TOOL_PREFIX])
--- a/src/configure
+++ b/src/configure
@@ -616,6 +616,7 @@ AR_FOR_TARGET
 GM2_FOR_TARGET
 GDC_FOR_TARGET
 GOC_FOR_TARGET
+GA68_FOR_TARGET
 GFORTRAN_FOR_TARGET
 GCC_FOR_TARGET
 CXX_FOR_TARGET
@@ -624,6 +625,7 @@ RANLIB_PLUGIN_OPTION
 AR_PLUGIN_OPTION
 PKG_CONFIG_PATH
 GDCFLAGS
+GA68FLAGS
 READELF
 OTOOL
 OBJDUMP
@@ -655,6 +657,7 @@ LD_FOR_BUILD
 LDFLAGS_FOR_BUILD
 GDC_FOR_BUILD
 GOC_FOR_BUILD
+GA68_FOR_BUILD
 GFORTRAN_FOR_BUILD
 DSYMUTIL_FOR_BUILD
 DLLTOOL_FOR_BUILD
@@ -718,6 +721,7 @@ HAVE_CXX14
 do_compare
 CARGO
 GDC
+GA68
 GNATMAKE
 GNATBIND
 ac_ct_CXX
@@ -776,6 +780,7 @@ infodir
 docdir
 oldincludedir
 includedir
+runstatedir
 localstatedir
 sharedstatedir
 sysconfdir
@@ -818,6 +823,7 @@ enable_libquadmath
 enable_libquadmath_support
 enable_libada
 enable_libgm2
+enable_libga68
 enable_libssp
 enable_libstdcxx
 enable_bootstrap
@@ -848,6 +854,7 @@ enable_host_shared
 enable_libgdiagnostics
 enable_stage1_languages
 enable_objc_gc
+enable_algol68_gc
 with_target_bdw_gc
 with_target_bdw_gc_include
 with_target_bdw_gc_lib
@@ -895,6 +902,7 @@ CC_FOR_TARGET
 CXX_FOR_TARGET
 GCC_FOR_TARGET
 GFORTRAN_FOR_TARGET
+GA68_FOR_TARGET
 GOC_FOR_TARGET
 GDC_FOR_TARGET
 GM2_FOR_TARGET
@@ -951,6 +959,7 @@ datadir='${datarootdir}'
 sysconfdir='${prefix}/etc'
 sharedstatedir='${prefix}/com'
 localstatedir='${prefix}/var'
+runstatedir='${localstatedir}/run'
 includedir='${prefix}/include'
 oldincludedir='/usr/include'
 docdir='${datarootdir}/doc/${PACKAGE}'
@@ -1203,6 +1212,15 @@ do
   | -silent | --silent | --silen | --sile | --sil)
     silent=yes ;;
 
+  -runstatedir | --runstatedir | --runstatedi | --runstated \
+  | --runstate | --runstat | --runsta | --runst | --runs \
+  | --run | --ru | --r)
+    ac_prev=runstatedir ;;
+  -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \
+  | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \
+  | --run=* | --ru=* | --r=*)
+    runstatedir=$ac_optarg ;;
+
   -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
     ac_prev=sbindir ;;
   -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
@@ -1340,7 +1358,7 @@ fi
 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
+		libdir localedir mandir runstatedir
 do
   eval ac_val=\$$ac_var
   # Remove trailing slashes.
@@ -1500,6 +1518,7 @@ Fine tuning of the installation directories:
   --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]
+  --runstatedir=DIR       modifiable per-process data [LOCALSTATEDIR/run]
   --libdir=DIR            object code libraries [EPREFIX/lib]
   --includedir=DIR        C header files [PREFIX/include]
   --oldincludedir=DIR     C header files for non-gcc [/usr/include]
@@ -1564,6 +1583,7 @@ Optional Features:
                           disable libquadmath support for Fortran
   --enable-libada         build libada directory
   --enable-libgm2         build libgm2 directory
+  --enable-libga68        build libga68 directory
   --enable-libssp         build libssp directory
   --disable-libstdcxx     do not build libstdc++-v3 directory
   --enable-bootstrap      enable bootstrapping [yes if native build]
@@ -1587,6 +1607,8 @@ Optional Features:
                           Mostly useful for compiler development
   --enable-objc-gc        enable use of Boehm's garbage collector with the GNU
                           Objective-C runtime
+  --enable-algol68-gc     enable use of Boehm's garbage collector with the GNU
+                          Algol runtime
   --enable-vtable-verify  Enable vtable verification feature
   --enable-serial-[{host,target,build}-]configure
                           force sequential configuration of sub-packages for
@@ -1699,6 +1721,8 @@ Some influential environment variables:
               GCC for the target
   GFORTRAN_FOR_TARGET
               GFORTRAN for the target
+  GA68_FOR_TARGET
+              GA68 for the target
   GOC_FOR_TARGET
               GOC for the target
   GDC_FOR_TARGET
@@ -2866,6 +2890,7 @@ target_libraries="target-libgcc \
 		target-libgcobol \
 		target-libada \
 		target-libgm2 \
+                target-libga68 \
 		target-libgo \
 		target-libgrust \
 		target-libphobos \
@@ -3269,6 +3294,14 @@ if test "${ENABLE_LIBGM2}" != "yes" ; then
   noconfigdirs="$noconfigdirs gm2tools"
 fi
 
+# Check whether --enable-libga68 was given.
+if test "${enable_libga68+set}" = set; then :
+  enableval=$enable_libga68; ENABLE_LIBGA68=$enableval
+else
+  ENABLE_LIBGA68=yes
+fi
+
+
 # Check whether --enable-libssp was given.
 if test "${enable_libssp+set}" = set; then :
   enableval=$enable_libssp; ENABLE_LIBSSP=$enableval
@@ -4247,6 +4280,7 @@ if test "${build}" != "${host}" ; then
   CXX_FOR_BUILD=${CXX_FOR_BUILD-g++}
   DSYMUTIL_FOR_BUILD=${DSYMUTIL_FOR_BUILD-dsymutil}
   GFORTRAN_FOR_BUILD=${GFORTRAN_FOR_BUILD-gfortran}
+  GA68_FOR_BUILD=${GA68_FOR_BUILD-ga68}
   GOC_FOR_BUILD=${GOC_FOR_BUILD-gccgo}
   GDC_FOR_BUILD=${GDC_FOR_BUILD-gdc}
   DLLTOOL_FOR_BUILD=${DLLTOOL_FOR_BUILD-dlltool}
@@ -4262,6 +4296,7 @@ else
   CXX_FOR_BUILD="\$(CXX)"
   DSYMUTIL_FOR_BUILD="\$(DSYMUTIL)"
   GFORTRAN_FOR_BUILD="\$(GFORTRAN)"
+  GA68_FOR_BUILD="\$(GA68)"
   GOC_FOR_BUILD="\$(GOC)"
   GDC_FOR_BUILD="\$(GDC)"
   DLLTOOL_FOR_BUILD="\$(DLLTOOL)"
@@ -5782,6 +5817,100 @@ fi
 
 
 
+if test -n "$ac_tool_prefix"; then
+  # Extract the first word of "${ac_tool_prefix}ga68", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ga68; 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_GA68+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$GA68"; then
+  ac_cv_prog_GA68="$GA68" # 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_GA68="${ac_tool_prefix}ga68"
+    $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
+GA68=$ac_cv_prog_GA68
+if test -n "$GA68"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GA68" >&5
+$as_echo "$GA68" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+fi
+if test -z "$ac_cv_prog_GA68"; then
+  ac_ct_GA68=$GA68
+  # Extract the first word of "ga68", so it can be a program name with args.
+set dummy ga68; 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_GA68+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$ac_ct_GA68"; then
+  ac_cv_prog_ac_ct_GA68="$ac_ct_GA68" # 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_GA68="ga68"
+    $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_GA68=$ac_cv_prog_ac_ct_GA68
+if test -n "$ac_ct_GA68"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_GA68" >&5
+$as_echo "$ac_ct_GA68" >&6; }
+else
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+  if test "x$ac_ct_GA68" = x; then
+    GA68="no"
+  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
+    GA68=$ac_ct_GA68
+  fi
+else
+  GA68="$ac_cv_prog_GA68"
+fi
+
+
+
 if test -n "$ac_tool_prefix"; then
   # Extract the first word of "${ac_tool_prefix}gdc", so it can be a program name with args.
 set dummy ${ac_tool_prefix}gdc; ac_word=$2
@@ -10328,6 +10457,11 @@ if test "${enable_objc_gc+set}" = set; then :
   enableval=$enable_objc_gc;
 fi
 
+# Check whether --enable-algol68-gc was given.
+if test "${enable_algol68_gc+set}" = set; then :
+  enableval=$enable_algol68_gc;
+fi
+
 
 # Check whether --with-target-bdw-gc was given.
 if test "${with_target_bdw_gc+set}" = set; then :
@@ -10347,22 +10481,23 @@ if test "${with_target_bdw_gc_lib+set}" = set; then :
 fi
 
 
-case ,${enable_languages},:${enable_objc_gc} in *,objc,*:yes|*,objc,*:auto)
-  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bdw garbage collector" >&5
+case ,${enable_languages},:${enable_objc_gc}:${enable_algol68_gc} in
+  *,objc,*:yes:*|*,objc,*:auto:*|*,algol68,*:*:yes|*,algol68,*:*:auto)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bdw garbage collector" >&5
 $as_echo_n "checking for bdw garbage collector... " >&6; }
-  if test "x$with_target_bdw_gc$with_target_bdw_gc_include$with_target_bdw_gc_lib" = x; then
-        { $as_echo "$as_me:${as_lineno-$LINENO}: result: using bdw-gc in default locations" >&5
+    if test "x$with_target_bdw_gc$with_target_bdw_gc_include$with_target_bdw_gc_lib" = x; then
+            { $as_echo "$as_me:${as_lineno-$LINENO}: result: using bdw-gc in default locations" >&5
 $as_echo "using bdw-gc in default locations" >&6; }
-  else
-        if test "x$with_target_bdw_gc_include" = x && test "x$with_target_bdw_gc_lib" != x; then
-      as_fn_error $? "found --with-target-bdw-gc-lib but --with-target-bdw-gc-include missing" "$LINENO" 5
-    elif test "x$with_target_bdw_gc_include" != x && test "x$with_target_bdw_gc_lib" = x; then
-      as_fn_error $? "found --with-target-bdw-gc-include but --with-target-bdw-gc-lib missing" "$LINENO" 5
     else
-      { $as_echo "$as_me:${as_lineno-$LINENO}: result: using paths configured with --with-target-bdw-gc options" >&5
+            if test "x$with_target_bdw_gc_include" = x && test "x$with_target_bdw_gc_lib" != x; then
+        as_fn_error $? "found --with-target-bdw-gc-lib but --with-target-bdw-gc-include missing" "$LINENO" 5
+      elif test "x$with_target_bdw_gc_include" != x && test "x$with_target_bdw_gc_lib" = x; then
+        as_fn_error $? "found --with-target-bdw-gc-include but --with-target-bdw-gc-lib missing" "$LINENO" 5
+      else
+        { $as_echo "$as_me:${as_lineno-$LINENO}: result: using paths configured with --with-target-bdw-gc options" >&5
 $as_echo "using paths configured with --with-target-bdw-gc options" >&6; }
+      fi
     fi
-  fi
 esac
 
 # Disable libitm, libsanitizer, libvtv if we're not building C++
@@ -11683,6 +11818,7 @@ done
 
 
 
+
 
 # Generate default definitions for YACC, M4, LEX and other programs that run
 # on the build machine.  These are used if the Makefile can't locate these
@@ -14202,6 +14338,9 @@ fi
 
 
 
+GA68FLAGS=${GA68FLAGS-${CFLAGS}}
+
+
 GDCFLAGS=${GDCFLAGS-${CFLAGS}}
 
 
@@ -15003,6 +15142,167 @@ fi
 
 
 
+if test -n "$GA68_FOR_TARGET"; then
+  ac_cv_prog_GA68_FOR_TARGET=$GA68_FOR_TARGET
+elif test -n "$ac_cv_prog_GA68_FOR_TARGET"; then
+  GA68_FOR_TARGET=$ac_cv_prog_GA68_FOR_TARGET
+fi
+
+if test -n "$ac_cv_prog_GA68_FOR_TARGET"; then
+  for ncn_progname in ga68; 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_GA68_FOR_TARGET+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$GA68_FOR_TARGET"; then
+  ac_cv_prog_GA68_FOR_TARGET="$GA68_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_GA68_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
+GA68_FOR_TARGET=$ac_cv_prog_GA68_FOR_TARGET
+if test -n "$GA68_FOR_TARGET"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GA68_FOR_TARGET" >&5
+$as_echo "$GA68_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_GA68_FOR_TARGET" && test -n "$with_build_time_tools"; then
+  for ncn_progname in ga68; 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_GA68_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_GA68_FOR_TARGET"; then
+  for ncn_progname in ga68; 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_GA68_FOR_TARGET+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$GA68_FOR_TARGET"; then
+  ac_cv_prog_GA68_FOR_TARGET="$GA68_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_GA68_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
+GA68_FOR_TARGET=$ac_cv_prog_GA68_FOR_TARGET
+if test -n "$GA68_FOR_TARGET"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GA68_FOR_TARGET" >&5
+$as_echo "$GA68_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_GA68_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_GA68_FOR_TARGET+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  if test -n "$GA68_FOR_TARGET"; then
+  ac_cv_prog_GA68_FOR_TARGET="$GA68_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_GA68_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
+GA68_FOR_TARGET=$ac_cv_prog_GA68_FOR_TARGET
+if test -n "$GA68_FOR_TARGET"; then
+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GA68_FOR_TARGET" >&5
+$as_echo "$GA68_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_GA68_FOR_TARGET" && break
+  done
+fi
+
+if test -z "$ac_cv_prog_GA68_FOR_TARGET" ; then
+  set dummy ga68
+  if test $build = $target ; then
+    GA68_FOR_TARGET="$2"
+  else
+    GA68_FOR_TARGET="${ncn_target_tool_prefix}$2"
+  fi
+else
+  GA68_FOR_TARGET="$ac_cv_prog_GA68_FOR_TARGET"
+fi
+
+
+
 if test -n "$GOC_FOR_TARGET"; then
   ac_cv_prog_GOC_FOR_TARGET=$GOC_FOR_TARGET
 elif test -n "$ac_cv_prog_GOC_FOR_TARGET"; then
@@ -19469,6 +19769,51 @@ $as_echo "pre-installed" >&6; }
   fi
 fi
 
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking where to find the target ga68" >&5
+$as_echo_n "checking where to find the target ga68... " >&6; }
+if test "x${build}" != "x${host}" ; then
+  if expr "x$GA68_FOR_TARGET" : "x/" > /dev/null; then
+    # We already found the complete path
+    ac_dir=`dirname $GA68_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
+    *,algol68,*) ;;
+    *) ok=no ;;
+  esac
+  if test $ok = yes; then
+    # An in-tree tool is available and we can use it
+    GA68_FOR_TARGET='$$r/$(HOST_SUBDIR)/gcc/ga68 -B$$r/$(HOST_SUBDIR)/gcc/'
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: just compiled" >&5
+$as_echo "just compiled" >&6; }
+  elif expr "x$GA68_FOR_TARGET" : "x/" > /dev/null; then
+    # We already found the complete path
+    ac_dir=`dirname $GA68_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
+    GA68_FOR_TARGET='$(GA68)'
+    { $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 gdc" >&5
 $as_echo_n "checking where to find the target gdc... " >&6; }
 if test "x${build}" != "x${host}" ; then
--- a/src/configure.ac
+++ b/src/configure.ac
@@ -164,6 +164,7 @@ target_libraries="target-libgcc \
 		target-libgcobol \
 		target-libada \
 		target-libgm2 \
+                target-libga68 \
 		target-libgo \
 		target-libgrust \
 		target-libphobos \
@@ -512,6 +513,11 @@ if test "${ENABLE_LIBGM2}" != "yes" ; then
   noconfigdirs="$noconfigdirs gm2tools"
 fi
 
+AC_ARG_ENABLE(libga68,
+[AS_HELP_STRING([--enable-libga68], [build libga68 directory])],
+ENABLE_LIBGA68=$enableval,
+ENABLE_LIBGA68=yes)
+
 AC_ARG_ENABLE(libssp,
 [AS_HELP_STRING([--enable-libssp], [build libssp directory])],
 ENABLE_LIBSSP=$enableval,
@@ -1445,6 +1451,7 @@ if test "${build}" != "${host}" ; then
   CXX_FOR_BUILD=${CXX_FOR_BUILD-g++}
   DSYMUTIL_FOR_BUILD=${DSYMUTIL_FOR_BUILD-dsymutil}
   GFORTRAN_FOR_BUILD=${GFORTRAN_FOR_BUILD-gfortran}
+  GA68_FOR_BUILD=${GA68_FOR_BUILD-ga68}
   GOC_FOR_BUILD=${GOC_FOR_BUILD-gccgo}
   GDC_FOR_BUILD=${GDC_FOR_BUILD-gdc}
   DLLTOOL_FOR_BUILD=${DLLTOOL_FOR_BUILD-dlltool}
@@ -1460,6 +1467,7 @@ else
   CXX_FOR_BUILD="\$(CXX)"
   DSYMUTIL_FOR_BUILD="\$(DSYMUTIL)"
   GFORTRAN_FOR_BUILD="\$(GFORTRAN)"
+  GA68_FOR_BUILD="\$(GA68)"
   GOC_FOR_BUILD="\$(GOC)"
   GDC_FOR_BUILD="\$(GDC)"
   DLLTOOL_FOR_BUILD="\$(DLLTOOL)"
@@ -1513,6 +1521,7 @@ int main() {}])],
 fi
 
 ACX_PROG_GNAT
+ACX_PROG_GA68
 ACX_PROG_GDC
 ACX_PROG_CARGO
 ACX_PROG_CMP_IGNORE_INITIAL
@@ -2637,6 +2646,10 @@ AC_ARG_ENABLE(objc-gc,
 [AS_HELP_STRING([--enable-objc-gc],
 		[enable use of Boehm's garbage collector with the
 		 GNU Objective-C runtime])])
+AC_ARG_ENABLE(algol68-gc,
+[AS_HELP_STRING([--enable-algol68-gc],
+                [enable use of Boehm's garbage collector with the
+                 GNU Algol runtime])])
 AC_ARG_WITH([target-bdw-gc],
 [AS_HELP_STRING([--with-target-bdw-gc=PATHLIST],
 		[specify prefix directory for installed bdw-gc package.
@@ -2649,21 +2662,22 @@ AC_ARG_WITH([target-bdw-gc-lib],
 [AS_HELP_STRING([--with-target-bdw-gc-lib=PATHLIST],
 		[specify directories for installed bdw-gc library])])
 		  
-case ,${enable_languages},:${enable_objc_gc} in *,objc,*:yes|*,objc,*:auto)
-  AC_MSG_CHECKING([for bdw garbage collector])
-  if test "x$with_target_bdw_gc$with_target_bdw_gc_include$with_target_bdw_gc_lib" = x; then
-    dnl no bdw-gw options, assume default locations
-    AC_MSG_RESULT([using bdw-gc in default locations])
-  else
-    dnl bdw-gw options, first error checking, complete checking in libobjc
-    if test "x$with_target_bdw_gc_include" = x && test "x$with_target_bdw_gc_lib" != x; then
-      AC_MSG_ERROR([found --with-target-bdw-gc-lib but --with-target-bdw-gc-include missing])
-    elif test "x$with_target_bdw_gc_include" != x && test "x$with_target_bdw_gc_lib" = x; then
-      AC_MSG_ERROR([found --with-target-bdw-gc-include but --with-target-bdw-gc-lib missing])
+case ,${enable_languages},:${enable_objc_gc}:${enable_algol68_gc} in
+  *,objc,*:yes:*|*,objc,*:auto:*|*,algol68,*:*:yes|*,algol68,*:*:auto)
+    AC_MSG_CHECKING([for bdw garbage collector])
+    if test "x$with_target_bdw_gc$with_target_bdw_gc_include$with_target_bdw_gc_lib" = x; then
+      dnl no bdw-gw options, assume default locations
+      AC_MSG_RESULT([using bdw-gc in default locations])
     else
-      AC_MSG_RESULT([using paths configured with --with-target-bdw-gc options])
+      dnl bdw-gw options, first error checking, complete checking in libobjc and libga68
+      if test "x$with_target_bdw_gc_include" = x && test "x$with_target_bdw_gc_lib" != x; then
+        AC_MSG_ERROR([found --with-target-bdw-gc-lib but --with-target-bdw-gc-include missing])
+      elif test "x$with_target_bdw_gc_include" != x && test "x$with_target_bdw_gc_lib" = x; then
+        AC_MSG_ERROR([found --with-target-bdw-gc-include but --with-target-bdw-gc-lib missing])
+      else
+        AC_MSG_RESULT([using paths configured with --with-target-bdw-gc options])
+      fi
     fi
-  fi
 esac
 
 # Disable libitm, libsanitizer, libvtv if we're not building C++
@@ -3902,6 +3916,7 @@ AC_SUBST(CXX_FOR_BUILD)
 AC_SUBST(DLLTOOL_FOR_BUILD)
 AC_SUBST(DSYMUTIL_FOR_BUILD)
 AC_SUBST(GFORTRAN_FOR_BUILD)
+AC_SUBST(GA68_FOR_BUILD)
 AC_SUBST(GOC_FOR_BUILD)
 AC_SUBST(GDC_FOR_BUILD)
 AC_SUBST(LDFLAGS_FOR_BUILD)
@@ -3996,6 +4011,9 @@ AC_SUBST(CC)
 AC_SUBST(CXX)
 AC_SUBST(CFLAGS)
 AC_SUBST(CXXFLAGS)
+AC_SUBST(GA68)
+AC_SUBST(GA68FLAGS)
+GA68FLAGS=${GA68FLAGS-${CFLAGS}}
 AC_SUBST(GDC)
 AC_SUBST(GDCFLAGS)
 GDCFLAGS=${GDCFLAGS-${CFLAGS}}
@@ -4032,6 +4050,7 @@ NCN_STRICT_CHECK_TARGET_TOOLS(CC_FOR_TARGET, cc gcc)
 NCN_STRICT_CHECK_TARGET_TOOLS(CXX_FOR_TARGET, c++ g++ cxx gxx)
 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(GA68_FOR_TARGET, ga68)
 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)
@@ -4083,6 +4102,8 @@ GCC_TARGET_TOOL(gfortran, GFORTRAN_FOR_TARGET, GFORTRAN,
 		[gcc/gfortran -B$$r/$(HOST_SUBDIR)/gcc/], fortran)
 GCC_TARGET_TOOL(gccgo, GOC_FOR_TARGET, GOC,
 		[gcc/gccgo -B$$r/$(HOST_SUBDIR)/gcc/], go)
+GCC_TARGET_TOOL(ga68, GA68_FOR_TARGET, GA68,
+                [gcc/ga68 -B$$r/$(HOST_SUBDIR)/gcc/], algol68)
 GCC_TARGET_TOOL(gdc, GDC_FOR_TARGET, GDC,
 		[gcc/gdc -B$$r/$(HOST_SUBDIR)/gcc/], d)
 GCC_TARGET_TOOL(gm2, GM2_FOR_TARGET, GM2,
--- a/src/contrib/gcc-changelog/git_commit.py
+++ b/src/contrib/gcc-changelog/git_commit.py
@@ -88,6 +88,7 @@ default_changelog_locations = {
 
 bug_components = {
     'ada',
+    'algol68',
     'analyzer',
     'boehm-gc',
     'bootstrap',
--- a/src/gcc/Makefile.in
+++ b/src/gcc/Makefile.in
@@ -615,6 +615,8 @@ tm_d_file_list=@tm_d_file_list@
 tm_d_include_list=@tm_d_include_list@
 tm_rust_file_list=@tm_rust_file_list@
 tm_rust_include_list=@tm_rust_include_list@
+tm_algol68_file_list=@tm_algol68_file_list@
+tm_algol68_include_list=@tm_algol68_include_list@
 build_xm_file_list=@build_xm_file_list@
 build_xm_include_list=@build_xm_include_list@
 build_xm_defines=@build_xm_defines@
@@ -919,6 +921,7 @@ TCONFIG_H = tconfig.h $(xm_file_list)
 TM_P_H    = tm_p.h    $(tm_p_file_list) $(TREE_H)
 TM_D_H    = tm_d.h    $(tm_d_file_list)
 TM_RUST_H = tm_rust.h $(tm_rust_file_list)
+TM_ALGOL68_H = tm_algol68.h $(tm_algol68_file_list)
 GTM_H     = tm.h      $(tm_file_list) insn-constants.h
 TM_H      = $(GTM_H) insn-flags.h $(OPTIONS_H)
 
@@ -978,11 +981,13 @@ C_TARGET_DEF = c-family/c-target.def target-hooks-macros.h
 COMMON_TARGET_DEF = common/common-target.def target-hooks-macros.h
 D_TARGET_DEF = d/d-target.def target-hooks-macros.h
 RUST_TARGET_DEF = rust/rust-target.def target-hooks-macros.h
+ALGOL68_TARGET_DEF = algol68/algol68-target.def target-hooks-macros.h
 TARGET_H = $(TM_H) target.h $(TARGET_DEF) insn-modes.h insn-codes.h
 C_TARGET_H = c-family/c-target.h $(C_TARGET_DEF)
 COMMON_TARGET_H = common/common-target.h $(INPUT_H) $(COMMON_TARGET_DEF)
 D_TARGET_H = d/d-target.h $(D_TARGET_DEF)
 RUST_TARGET_H = rust/rust-target.h $(RUST_TARGET_DEF)
+ALGOL68_TARGET_H = algol68/algol68-target.h $(ALGOL68_TARGET_DEF)
 MACHMODE_H = machmode.h mode-classes.def
 HOOKS_H = hooks.h
 HOSTHOOKS_DEF_H = hosthooks-def.h $(HOOKS_H)
@@ -1303,6 +1308,9 @@ FORTRAN_TARGET_OBJS=@fortran_target_objs@
 # Target specific, Rust specific object file
 RUST_TARGET_OBJS=@rust_target_objs@
 
+# Target specific, Algol68 specific object file
+ALGOL68_TARGET_OBJS=@algol68_target_objs@
+
 # Object files for gcc many-languages driver.
 GCC_OBJS = gcc.o gcc-main.o ggc-none.o gcc-urlifier.o options-urls.o
 
@@ -2082,6 +2090,7 @@ tm.h: cs-tm.h ; @true
 tm_p.h: cs-tm_p.h ; @true
 tm_d.h: cs-tm_d.h ; @true
 tm_rust.h: cs-tm_rust.h ; @true
+tm_algol68.h: cs-tm_algol68.h; @true
 
 cs-config.h: Makefile
 	TARGET_CPU_DEFAULT="" \
@@ -2121,6 +2130,11 @@ cs-tm_rust.h: Makefile
 	HEADERS="$(tm_rust_include_list)" DEFINES="" \
 	$(SHELL) $(srcdir)/mkconfig.sh tm_rust.h
 
+cs-tm_algol68.h: Makefile
+	TARGET_CPU_DEFAULT="" \
+	HEADERS="$(tm_algol68_include_list)" DEFINES="" \
+	$(SHELL) $(srcdir)/mkconfig.sh tm_algol68.h
+
 # Don't automatically run autoconf, since configure.ac might be accidentally
 # newer than configure.  Also, this writes into the source directory which
 # might be on a read-only file system.  If configured for maintainer mode
@@ -2594,6 +2608,12 @@ default-rust.o: config/default-rust.cc
 	$(COMPILE) $<
 	$(POSTCOMPILE)
 
+# Files used by the Algol68 language front end.
+
+default-algol68.o: config/default-algol68.cc
+	$(COMPILE) $<
+	$(POSTCOMPILE)
+
 # Language-independent files.
 
 DRIVER_DEFINES = \
@@ -2940,6 +2960,15 @@ s-rust-target-hooks-def-h: build/genhooks$(build_exeext)
 					     rust/rust-target-hooks-def.h
 	$(STAMP) s-rust-target-hooks-def-h
 
+algol68/algol68-target-hooks-def.h: s-algol68-target-hooks-def-h; @true
+
+s-algol68-target-hooks-def-h: build/genhooks$(build_exeext)
+	$(RUN_GEN) build/genhooks$(build_exeext) "Algol68 Target Hook" \
+					     > tmp-algol68-target-hooks-def.h
+	$(SHELL) $(srcdir)/../move-if-change tmp-algol68-target-hooks-def.h \
+					     algol68/algol68-target-hooks-def.h
+	$(STAMP) s-algol68-target-hooks-def-h
+
 # check if someone mistakenly only changed tm.texi.
 # We use a different pathname here to avoid a circular dependency.
 s-tm-texi: $(srcdir)/doc/../doc/tm.texi
@@ -3148,6 +3178,7 @@ generated_files = config.h tm.h $(TM_P_H) $(TM_D_H) $(TM_H) multilib.h \
        gimple-match-auto.h generic-match-auto.h \
        c-family/c-target-hooks-def.h d/d-target-hooks-def.h \
        $(TM_RUST_H) rust/rust-target-hooks-def.h \
+       $(TM_ALGOL68_H) algol68/algol68-target-hooks-def.h \
        case-cfn-macros.h \
        cfn-operators.pd omp-device-properties.h
 
@@ -3282,7 +3313,8 @@ build/genrecog.o : genrecog.cc $(RTL_BASE_H) $(BCONFIG_H) $(SYSTEM_H)	\
   $(CORETYPES_H) $(GTM_H) errors.h $(READ_MD_H) $(GENSUPPORT_H)		\
   $(HASH_TABLE_H) inchash.h
 build/genhooks.o : genhooks.cc $(TARGET_DEF) $(C_TARGET_DEF)		\
-  $(COMMON_TARGET_DEF) $(D_TARGET_DEF) $(RUST_TARGET_DEF) $(BCONFIG_H) \
+  $(COMMON_TARGET_DEF) $(D_TARGET_DEF) $(RUST_TARGET_DEF) $(ALGOL68_TARGET_DEF) \
+  $(BCONFIG_H) \
   $(SYSTEM_H) errors.h
 build/genmddump.o : genmddump.cc $(RTL_BASE_H) $(BCONFIG_H) $(SYSTEM_H)	\
   $(CORETYPES_H) $(GTM_H) errors.h $(READ_MD_H) $(GENSUPPORT_H)
@@ -3832,7 +3864,8 @@ $(build_htmldir)/gccinstall/index.html: $(TEXI_GCCINSTALL_FILES)
 .PHONY: regenerate-opt-urls
 OPT_URLS_HTML_DEPS = $(build_htmldir)/gcc/Option-Index.html \
 	$(build_htmldir)/gdc/Option-Index.html \
-	$(build_htmldir)/gfortran/Option-Index.html
+	$(build_htmldir)/gfortran/Option-Index.html \
+	$(build_htmldir)/ga68/Option-Index.html
 $(OPT_URLS_HTML_DEPS): %/Option-Index.html: %/index.html
 
 regenerate-opt-urls: $(srcdir)/regenerate-opt-urls.py $(OPT_URLS_HTML_DEPS)
--- /dev/null
+++ b/src/gcc/algol68/Make-lang.in
@@ -0,0 +1,272 @@
+# Make-lang.in -- Top level -*- makefile -*- fragment for GCC Algol 68
+# frontend.
+
+# Copyright (C) 2025 Free Software Foundation, Inc.
+
+# This file is NOT 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 file provides the language dependent support in the main Makefile.
+
+.PHONY: algol68
+
+# Installation name.
+
+A68_INSTALL_NAME = $(shell echo ga68|sed '$(program_transform_name)')
+A68_TARGET_INSTALL_NAME = $(target_noncanonical)-$(shell echo ga68|sed '$(program_transform_name)')
+
+# General hooks
+
+algol68: a681$(exeext)
+algol68.serial = a681$(exeext)
+
+.PHONY: algol68
+
+# Use maximal warnings for this front end.
+algol68-warn = $(STRICT_WARN)
+
+# First the driver, ga68.
+
+GA68_OBJS = \
+   $(GCC_OBJS) \
+   algol68/a68spec.o \
+   $(END)
+
+a68spec.o: $(srcdir)/algol68/a68spec.cc $(SYSTEM_H) coretypes.h $(TM_H) $(GCC_H) \
+     $(CONFIG_H) opts.h
+	$(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(DRIVER_DEFINES) \
+                $(INCLUDES) $(srcdir)/algol68/a68spec.cc
+
+ga68$(exeext): $(GA68_OBJS) $(EXTRA_GCC_OBJS) libcommon-target.a $(LIBDEPS)
+	+$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ \
+	  $(GA68_OBJS) $(EXTRA_GCC_OBJS) libcommon-target.a \
+	  $(EXTRA_GCC_LIBS) $(LIBS)
+
+# Now the compiler proper, a681.
+
+ALGOL68_OBJS = algol68/a68-lang.o \
+               algol68/a68-unistr.o \
+               algol68/a68-moids-diagnostics.o \
+               algol68/a68-moids-misc.o \
+               algol68/a68-moids-to-string.o \
+               algol68/a68-postulates.o \
+               algol68/a68-diagnostics.o \
+               algol68/a68-parser.o \
+               algol68/a68-parser-keywords.o \
+               algol68/a68-parser-bottom-up.o \
+               algol68/a68-parser-brackets.o \
+               algol68/a68-parser-debug.o \
+               algol68/a68-parser-extract.o \
+               algol68/a68-parser-modes.o \
+               algol68/a68-parser-moids-check.o \
+               algol68/a68-parser-moids-coerce.o \
+               algol68/a68-parser-moids-equivalence.o \
+               algol68/a68-parser-scanner.o \
+               algol68/a68-parser-scope.o \
+               algol68/a68-parser-serial-dsa.o \
+               algol68/a68-parser-taxes.o \
+               algol68/a68-parser-top-down.o \
+               algol68/a68-parser-victal.o \
+               algol68/a68-parser-prelude.o \
+               algol68/a68-low.o \
+               algol68/a68-low-builtins.o \
+               algol68/a68-low-clauses.o \
+               algol68/a68-low-coercions.o \
+               algol68/a68-low-decls.o \
+               algol68/a68-low-generator.o \
+               algol68/a68-low-misc.o \
+               algol68/a68-low-moids.o \
+               algol68/a68-low-multiples.o \
+               algol68/a68-low-refs.o \
+               algol68/a68-low-procs.o \
+               algol68/a68-low-structs.o \
+               algol68/a68-low-chars.o \
+               algol68/a68-low-strings.o \
+               algol68/a68-low-ints.o \
+               algol68/a68-low-bools.o \
+               algol68/a68-low-reals.o \
+               algol68/a68-low-complex.o \
+               algol68/a68-low-bits.o \
+               algol68/a68-low-posix.o \
+               algol68/a68-low-prelude.o \
+               algol68/a68-low-ranges.o \
+               algol68/a68-low-runtime.o \
+               algol68/a68-low-unions.o \
+               algol68/a68-low-units.o \
+               $(END)
+
+ALGOL68_ALL_OBJS = $(ALGOL68_OBJS) $(ALGOL68_TARGET_OBJS)
+
+algol68_OBJS = $(ALGOL68_ALL_OBJS) algol68/a68spec.o
+
+a681$(exeext): $(ALGOL68_ALL_OBJS) attribs.o $(BACKEND) $(LIBDEPS) $(algol68.prev)
+	@$(call LINK_PROGRESS,$(INDEX.algol68),start)
+	+$(LLINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ \
+	      $(ALGOL68_OBJS) attribs.o $(BACKEND) $(LIBS) $(A681_LIBS) $(BACKENDLIBS)
+	@$(call LINK_PROGRESS,$(INDEX.algol68),end)
+
+algol68/tfspec.o: $(srcdir)/algol68/tfspec.c \
+                     $(SYSTEM_H) coretypes.h $(TM_H) $(GCC_H) $(CONFIG_H) $(TREE_H)
+
+# Documentation.
+
+A68_MANUAL_FILES =
+
+A68_MANUAL_FILES = \
+		algol68/ga68.texi \
+		$(gcc_docdir)/include/fdl.texi \
+		$(gcc_docdir)/include/gpl_v3.texi \
+		$(gcc_docdir)/include/gcc-common.texi \
+		gcc-vers.texi
+
+A68_INT_MANUAL_FILES = \
+		algol68/ga68-internals.texi \
+		$(gcc_docdir)/include/fdl.texi \
+		$(gcc_docdir)/include/gcc-common.texi \
+		gcc-vers.texi
+
+A68_TEXI_FILES = $(A68_MANUAL_FILES) $(A68_INT_MANUAL_FILES)
+
+doc/ga68.info: $(A68_MANUAL_FILES)
+	if test "x$(BUILD_INFO)" = xinfo; then \
+	  rm -f doc/ga68.info*; \
+	  $(MAKEINFO) $(MAKEINFOFLAGS) -I $(gcc_docdir) \
+		-I $(gcc_docdir)/include -o $@ $<; \
+	else true; fi
+
+doc/ga68-internals.info: $(A68_INT_MANUAL_FILES)
+	if test "x$(BUILD_INFO)" = xinfo; then \
+	  rm -f doc/ga68-internals.info*; \
+	  $(MAKEINFO) $(MAKEINFOFLAGS) -I $(gcc_docdir) \
+		-I $(gcc_docdir)/include -o $@ $<; \
+	else true; fi
+
+doc/ga68.dvi: $(A68_MANUAL_FILES)
+	$(TEXI2DVI) -I $(abs_docdir)/include -o $@ $<
+
+doc/ga68.pdf: $(A68_MANUAL_FILES)
+	$(TEXI2PDF) -I $(abs_docdir)/include -o $@ $<
+
+$(build_htmldir)/ga68/index.html: $(A68_MANUAL_FILES)
+	$(mkinstalldirs) $(@D)
+	rm -f $(@D)/*
+	$(TEXI2HTML) $(MAKEINFO_TOC_INLINE_FLAG) \
+		-I $(gcc_docdir)/include -I $(srcdir)/d -o $(@D) $<
+
+.INTERMEDIATE: ga68.pod
+
+ga68.pod: algol68/ga68.texi
+	-$(TEXI2POD) -D ga68 < $< > $@
+
+# Build hooks.
+
+algol68.srcextra:
+
+algol68.all.cross: ga68$(exeext)
+algol68.start.encap: ga68$(exeect)
+algol68.rest.encap:
+algol68.info: doc/ga68.info doc/ga68-internals.info
+algol68.dvi: doc/ga68.dvi
+algol68.pdf: doc/ga68.pdf
+algol68.install-pdf:
+algol68.html: $(build_htmldir)/ga68/index.html $(build_htmldir)/ga68-internals/index.html
+algol68.man: doc/ga68.1
+algol68.srcinfo: doc/ga68.info doc/ga68-internals.info
+	-cp -p $^ $(srcdir)/doc
+algol68.srcinfo:
+algol68.srcman:
+algol68.srcman: doc/ga68.1
+	-cp -p $^ $(srcdir)/doc
+algol68.install-plugin:
+
+algol68.tags: force
+	cd $(srcdir)/algol68; etags -o TAGS.sub *.c *.h; \
+	etags --include TAGS.sub --include ../TAGS.sub
+
+lang_checks += check-algol68
+lang_checks_parallelized += check-algol68
+check_algol68_parallelize = 10
+
+selftest-algol68:
+
+#
+# Install hooks:
+
+algol68.install-common: installdirs
+	-rm -f $(DESTDIR)$(bindir)/$(A68_INSTALL_NAME)$(exeext)
+	$(INSTALL_PROGRAM) ga68$(exeext) $(DESTDIR)$(bindir)/$(A68_INSTALL_NAME)$(exeext)
+
+algol68.install-man: $(DESTDIR)$(man1dir)/$(A68_INSTALL_NAME)$(man1ext)
+
+$(DESTDIR)$(man1dir)/$(A68_INSTALL_NAME)$(man1ext): doc/ga68.1 installdirs
+	-rm -f $@
+	-$(INSTALL_DATA) $< $@
+	-chmod a-x $@
+
+$(DESTDIR)$(man7dir)/%.7algol: doc/%.7algol installdirs
+	-rm -f $@
+	-$(INSTALL_DATA) $< $@
+	-chmod a-x $@
+
+algol68.install-info: $(DESTDIR)$(infodir)/ga68.info $(DESTDIR)$(infodir)/ga68-internals.info
+
+algol68.install-html: $(build_htmldir)/ga68 $(build_htmldir)/ga68-internals
+	@$(NORMAL_INSTALL)
+	test -z "$(htmldir)" || $(mkinstalldirs) "$(DESTDIR)$(htmldir)"
+	@for p in $(build_htmldir)/ga68; do \
+	  if test -f "$$p" || test -d "$$p"; then d=""; else d="$(srcdir)/"; fi; \
+	  f=$(html__strip_dir) \
+	  if test -d "$$d$$p"; then \
+	    echo " $(mkinstalldirs) '$(DESTDIR)$(htmldir)/$$f'"; \
+	    $(mkinstalldirs) "$(DESTDIR)$(htmldir)/$$f" || exit 1; \
+	    echo " $(INSTALL_DATA) '$$d$$p'/* '$(DESTDIR)$(htmldir)/$$f'"; \
+	    $(INSTALL_DATA) "$$d$$p"/* "$(DESTDIR)$(htmldir)/$$f"; \
+	  else \
+	    echo " $(INSTALL_DATA) '$$d$$p' '$(DESTDIR)$(htmldir)/$$f'"; \
+	    $(INSTALL_DATA) "$$d$$p" "$(DESTDIR)$(htmldir)/$$f"; \
+	  fi; \
+	done
+
+algol68.uninstall:
+#
+# Clean hooks:
+# A lot of the ancillary files are deleted by the main makefile.
+# We just have to delete files specific to us.
+algol68.mostlyclean:
+	-rm -f algol68/*$(objext) algol68/xforward algol68/fflags
+	-rm -f algol68/*$(coverageexts)
+algol68.clean: algol68.mostlyclean
+algol68.distclean:
+	-rm -f algol68/Makefile algol68/Make-host algol68/Make-target
+	-rm -f algol68/config.status algol68/config.cache
+algol68.maintainer-clean:
+	-rm -f $(gcc_docdir)/*.7algol
+
+#
+# Stage hooks:
+
+algol68.stage1: stage1-start
+	-mv algol68/*$(objext) stage1/algol68
+algol68.stage2: stage2-start
+	-mv algol68/*$(objext) stage2/algol68
+algol68.stage3: stage3-start
+	-mv algol68/*$(objext) stage3/algol68
+algol68.stage4: stage4-start
+	-mv algol68/*$(objext) stage4/algol68
+algol68.stageprofile: stageprofile-start
+	-mv algol68/*$(objext) stageprofile/algol68
+algol68.stagefeedback: stagefeedback-start
+	-mv algol68/*$(objext) stagefeedback/algol68
--- /dev/null
+++ b/src/gcc/algol68/README
@@ -0,0 +1,126 @@
+This is the GNU Algol 68 compiler.
+
+This compiler implements the Algol 68 programming language
+(https://www.algol68-lang.org) as defined in the Revised Report, along
+with several GNU extensions to the language which are oriented to
+enhance its application in systems programming and to achieve a good
+integration in POSIX systems.
+
+The parser component used in this front-end has been adapted from
+Algol 68 Genie, an Algol 68 interpreter written by Marcel van der
+Veer.  It is worth noting that this parser is not your typical garden
+variety parser, as it is capable of effectively parsing the two-level
+grammar of Algol 68, which is no small task.  Parsing Algol 68 is
+notoriously difficult, and without Marcel's careful work of many years
+this front-end would most probably not exist.  It is also a beautiful
+implementation that is a delight to both read and work with.
+
+The syntax tree built by the parser is lowered into a GENERIC tree by
+a lowering pass, which then invokes the gimplifier and hands the
+resulting gimple IR over to the rest of the compilation, down the
+rabbit hole all the way to optimized assembly code.
+
+The compiler driver is called `ga68'.
+The compiler proper is called `a681'.
+
+Programs built by this compiler make use of the libga68 run-time
+library.
+
+Building
+========
+
+Configure and build GCC with:
+
+  $ mkdir build-algol68
+  $ cd build-algol68
+  $ ../configure --enable-languages=algol68
+  $ make
+  $ make install
+
+Alternatively you can configure and build a non-bootstrapped compiler,
+which is much faster to build.  But note that in this case you better
+pass some flags so the compiler gets built optimized, or the resulting
+compiler will be rather slow:
+
+  $ mkdir build-algol68
+  $ cd build-algol68
+  $ ../configure --enable-languages=algol68 BOOT_CFLAGS="-O2 -g" \
+      BOOT_CXXFLAGS="-O2 -g" \
+      STAGE1_CFLAGS="-O2 -g" \
+      STAGE1_CXXFLAGS="-O2 -g"
+  $ make
+  $ make install
+
+Debugging
+=========
+
+A few front-end specific options useful for debugging are:
+
+  '-fdump-algol68-tree'
+  Emits a textual representation of the parse tree as produced by the parser.
+
+  '-fdump-algol68-modes'
+  Emits a list of all parsed modes.
+
+See the Developer Options section in the GNU Algol Compiler manual for
+more hacking related options.
+
+Testing
+=======
+
+Invoke the full testsuite from the build directory:
+
+  $ make check-algol68
+
+You can pass -jN to run tests in parallel:
+
+  $ make -jN check-algol68
+
+Invoke a subset of the testsuite.  For example, to only run tests that
+involve compilation but not running:
+
+  $ make check-algol68 RUNTESTFLAGS="compile.exp"
+
+There are the following sets of tests:
+
+  compile.exp - compilation tests
+
+Invoke only a specific test:
+
+  $ make check-algol68 RUNTESTFLAGS="--all compile.exp=bad-coercion-1.a68"
+
+Test in both 32-bit and 64-bit in multilib arches:
+
+  $ make check-algol68 RUNTESTFLAGS="--target_board=unix\{-m64,-m32\}"
+
+Logs (with corresponding commands) can be found in
+BUILD/gcc/testsuite/algol68/algol68.log.
+
+See https://gcc.gnu.org/install/test.html for more details.
+
+Useful Resources
+================
+
+- An Emacs mode for editing Algol 68 programs can be found at
+  https://git.sr.ht/~jemarch/a68-mode.  It supports automatic
+  indentation, pretty-printing of bold tags, an auto-stropping minor
+  mode and other features.
+
+- The Algol 68 Jargon File at https://jemarch.net/a68-jargon provides
+  a comprehensive list of definitions of many of the technical and
+  non-technical terms used in the context of Algol 68.
+
+- The very formal Revised Report on the Algorithmic Language ALGOL 68
+  can be found at [1].
+
+- The truly delightful Informal Introduction to ALGOL 68 by C.H
+  Lindsey and van der Meulen can be found at [2].
+
+Community
+=========
+
+mailing list: algol68@gcc.gnu.org
+irc: irc.oftc.net - #gnualgol
+
+[1] https://www.softwarepreservation.org/projects/ALGOL/report/Algol68_revised_report-AB-600dpi.pdf
+[2] https://inria.hal.science/hal-03027689/file/Lindsey_van_der_Meulen-IItA68-Revised.pdf
--- /dev/null
+++ b/src/gcc/algol68/a68-diagnostics.cc
@@ -0,0 +1,360 @@
+/* Error and warning routines.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "diagnostic.h"
+
+#include "a68.h"
+
+/*
+ * Error handling routines.
+ */
+
+#define TABULATE(n) (8 * (n / 8 + 1) - n)
+
+/* Severities handled by the DIAGNOSTIC function defined below.  */
+
+#define A68_ERROR 0
+#define A68_WARNING 1
+#define A68_FATAL 2
+#define A68_SCAN_ERROR 3
+#define A68_INFORM 4
+
+/* Give a diagnostic message.  */
+
+static int
+diagnostic (int sev, int opt,
+	    NODE_T *p,
+	    LINE_T *line,
+	    char *pos,
+	    const char *loc_str, va_list args)
+{
+  int res = 0;
+  MOID_T *moid = NO_MOID;
+  const char *t = loc_str;
+  char b[BUFFER_SIZE];
+
+  b[0] = '\0';
+
+  /*
+   * Synthesize diagnostic message.
+   *
+   * Legend for special symbols:
+   * * as first character, copy rest of string literally
+   * @ non terminal
+   * A non terminal
+   * B keyword
+   * C context
+   * D argument in decimal
+   * H char argument
+   * K 'LONG'
+   * L line number
+   * M moid - if error mode return without giving a message
+   * N mode - M_NIL
+   * O moid - operand
+   * S quoted symbol, when possible with typographical display features
+   * X expected attribute
+   * Y string literal.
+   * Z quoted string literal.  */
+
+  if (t[0] == '*')
+    a68_bufcat (b, &t[1], BUFFER_SIZE);
+  else
+    while (t[0] != '\0')
+      {
+	if (t[0] == '@')
+	  {
+            const char *nt = a68_attribute_name (ATTRIBUTE (p));
+            if (t != NO_TEXT)
+              a68_bufcat (b, nt, BUFFER_SIZE);
+	    else
+              a68_bufcat (b, "construct", BUFFER_SIZE);
+          }
+	else if (t[0] == 'A')
+	  {
+            enum a68_attribute att = (enum a68_attribute) va_arg (args, int);
+            const char *nt = a68_attribute_name (att);
+            if (nt != NO_TEXT)
+              a68_bufcat (b, nt, BUFFER_SIZE);
+	    else
+              a68_bufcat (b, "construct", BUFFER_SIZE);
+          }
+	else if (t[0] == 'B')
+	  {
+            enum a68_attribute att = (enum a68_attribute) va_arg (args, int);
+            KEYWORD_T *nt = a68_find_keyword_from_attribute (A68 (top_keyword), att);
+            if (nt != NO_KEYWORD)
+	      {
+		a68_bufcat (b, "\"", BUFFER_SIZE);
+		a68_bufcat (b, TEXT (nt), BUFFER_SIZE);
+		a68_bufcat (b, "\"", BUFFER_SIZE);
+	      }
+	    else
+              a68_bufcat (b, "keyword", BUFFER_SIZE);
+          }
+	else if (t[0] == 'C')
+	  {
+            int att = va_arg (args, int);
+            if (att == NO_SORT)
+              a68_bufcat (b, "this", BUFFER_SIZE);
+            if (att == SOFT)
+              a68_bufcat (b, "a soft", BUFFER_SIZE);
+	    else if (att == WEAK)
+              a68_bufcat (b, "a weak", BUFFER_SIZE);
+	    else if (att == MEEK)
+              a68_bufcat (b, "a meek", BUFFER_SIZE);
+	    else if (att == FIRM)
+              a68_bufcat (b, "a firm", BUFFER_SIZE);
+	    else if (att == STRONG)
+              a68_bufcat (b, "a strong", BUFFER_SIZE);
+          }
+	else if (t[0] == 'D')
+	  {
+            int a = va_arg (args, int);
+            BUFFER d;
+            BUFCLR (d);
+            if (snprintf (d, SNPRINTF_SIZE, "%d", a) < 0)
+	      gcc_unreachable ();
+            a68_bufcat (b, d, BUFFER_SIZE);
+          }
+	else if (t[0] == 'H')
+	  {
+            char *a = va_arg (args, char *);
+            char d[SMALL_BUFFER_SIZE];
+            if (snprintf (d, (size_t) SMALL_BUFFER_SIZE, "\"%c\"", a[0]) < 0)
+	      gcc_unreachable ();
+            a68_bufcat (b, d, BUFFER_SIZE);
+          }
+	else if (t[0] == 'K')
+	  a68_bufcat (b, "LONG", BUFFER_SIZE);
+	else if (t[0] == 'L')
+	  {
+	    LINE_T *a = va_arg (args, LINE_T *);
+            char d[SMALL_BUFFER_SIZE];
+            gcc_assert (a != NO_LINE);
+            if (NUMBER (a) == 0)
+              a68_bufcat (b, "in standard environment", BUFFER_SIZE);
+	    else
+	      {
+		if (p != NO_NODE && NUMBER (a) == LINE_NUMBER (p))
+		  {
+		    if (snprintf (d, (size_t) SMALL_BUFFER_SIZE, "in this line") < 0)
+		      gcc_unreachable ();
+		  }
+		else
+		  {
+		    if (snprintf (d, (size_t) SMALL_BUFFER_SIZE, "in line %d", NUMBER (a)) < 0)
+		      gcc_unreachable ();
+		  }
+              a68_bufcat (b, d, BUFFER_SIZE);
+            }
+          }
+	else if (t[0] == 'M')
+	  {
+            moid = va_arg (args, MOID_T *);
+            if (moid == NO_MOID || moid == M_ERROR)
+              moid = M_UNDEFINED;
+
+            if (IS (moid, SERIES_MODE))
+	      {
+		if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK)
+		  a68_bufcat (b, a68_moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p),
+			  BUFFER_SIZE);
+		else
+		  a68_bufcat (b, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
+	      }
+	    else
+              a68_bufcat (b, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
+          }
+	else if (t[0] == 'N')
+	  {
+            a68_bufcat (b, "NIL name of mode ", BUFFER_SIZE);
+            moid = va_arg (args, MOID_T *);
+            if (moid != NO_MOID)
+              a68_bufcat (b, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
+          }
+	else if (t[0] == 'O')
+	  {
+            moid = va_arg (args, MOID_T *);
+            if (moid == NO_MOID || moid == M_ERROR)
+              moid = M_UNDEFINED;
+            if (moid == M_VOID)
+              a68_bufcat (b, "UNION (VOID, ..)", BUFFER_SIZE);
+	    else if (IS (moid, SERIES_MODE))
+	      {
+		if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK)
+		  a68_bufcat (b, a68_moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p), BUFFER_SIZE);
+		else
+		  a68_bufcat (b, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
+	      }
+	    else
+              a68_bufcat (b, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
+          }
+	else if (t[0] == 'S')
+	  {
+            if (p != NO_NODE && NSYMBOL (p) != NO_TEXT)
+	      {
+		const char *txt = NSYMBOL (p);
+		char *sym = NCHAR_IN_LINE (p);
+		int n = 0, size = (int) strlen (txt);
+
+		a68_bufcat (b, "\"", BUFFER_SIZE);
+		if (txt[0] != sym[0] || (int) strlen (sym) < size)
+		  a68_bufcat (b, txt, BUFFER_SIZE);
+		else
+		  {
+		    while (n < size)
+		      {
+			if (ISPRINT (sym[0]))
+			  {
+			    char str[2];
+			    str[0] = sym[0];
+			    str[1] = '\0';
+			    a68_bufcat (b, str, BUFFER_SIZE);
+			  }
+			if (TOLOWER (txt[0]) == TOLOWER (sym[0]))
+			  {
+			    txt++;
+			    n++;
+			  }
+			sym++;
+		      }
+		  }
+		a68_bufcat (b, "\"", BUFFER_SIZE);
+	      }
+	    else
+              a68_bufcat (b, "symbol", BUFFER_SIZE);
+          }
+	else if (t[0] == 'V')
+	  a68_bufcat (b, PACKAGE_STRING, BUFFER_SIZE);
+	else if (t[0] == 'X')
+	  {
+            enum a68_attribute att = (enum a68_attribute) (va_arg (args, int));
+	    const char *att_name = a68_attribute_name (att);
+            a68_bufcat (b, att_name, BUFFER_SIZE);
+          }
+	else if (t[0] == 'Y')
+	  {
+            char *loc_string = va_arg (args, char *);
+            a68_bufcat (b, loc_string, BUFFER_SIZE);
+          }
+	else if (t[0] == 'Z')
+	  {
+            char *loc_string = va_arg (args, char *);
+            a68_bufcat (b, "\"", BUFFER_SIZE);
+            a68_bufcat (b, loc_string, BUFFER_SIZE);
+            a68_bufcat (b, "\"", BUFFER_SIZE);
+          }
+	else
+	  {
+	    char q[2];
+            q[0] = t[0];
+            q[1] = '\0';
+            a68_bufcat (b, q, BUFFER_SIZE);
+          }
+	t++;
+      }
+
+  /* Construct a diagnostic message.  */
+  if (sev == A68_WARNING)
+    WARNING_COUNT (&A68_JOB)++;
+  else
+    ERROR_COUNT (&A68_JOB)++;
+
+  /* Emit the corresponding GCC diagnostic at the proper location.  */
+  location_t loc = UNKNOWN_LOCATION;
+
+  if (p != NO_NODE)
+    loc = a68_get_node_location (p);
+  else if (line != NO_LINE)
+    {
+      if (pos == NO_TEXT)
+	pos = STRING (line);
+      loc = a68_get_line_location (line, pos);
+    }
+
+  switch (sev)
+    {
+    case A68_SCAN_ERROR: error_at (loc, "%s", b); exit (FATAL_EXIT_CODE);
+    case A68_FATAL: fatal_error (loc, "%s", b); break;
+    case A68_INFORM: inform (loc, b); break;
+    case A68_WARNING: res = warning_at (loc, opt, "%s", b); break;
+    case A68_ERROR: error_at (loc, "%s", b); break;
+    default:
+      gcc_unreachable ();
+    }
+
+  return res;
+}
+
+/* Give an intelligible error and exit.  A line is provided rather than a
+   node so this can be used at scanning time.  */
+
+void
+a68_scan_error (LINE_T * u, char *v, const char *txt, ...)
+{
+  va_list args;
+
+  va_start (args, txt);
+  diagnostic (A68_SCAN_ERROR, 0, NO_NODE, u, v, txt, args);
+  va_end (args);
+}
+
+/* Report a compilation error.  */
+
+void
+a68_error (NODE_T *p, const char *loc_str, ...)
+{
+  va_list args;
+
+  va_start (args, loc_str);
+  diagnostic (A68_ERROR, 0, p, NO_LINE, NO_TEXT, loc_str, args); va_end (args);
+}
+
+/* Report a compilation warning.  */
+
+int
+a68_warning (NODE_T *p, int opt,
+	     const char *loc_str, ...)
+{
+  int res;
+  va_list args;
+
+  va_start (args, loc_str);
+  res = diagnostic (A68_WARNING, opt, p, NO_LINE, NO_TEXT, loc_str, args);
+  va_end (args);
+  return res;
+}
+
+/* Report a compilation note.  */
+
+void
+a68_inform (NODE_T *p, const char *loc_str, ...)
+{
+  va_list args;
+
+  va_start (args, loc_str);
+  diagnostic (A68_INFORM, 0, p, NO_LINE, NO_TEXT, loc_str, args);
+  va_end (args);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-lang.cc
@@ -0,0 +1,699 @@
+/* Language-dependent hooks for Algol 68.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "toplev.h"
+#include "langhooks.h"
+#include "langhooks-def.h"
+#include "target.h"
+#include "stringpool.h"
+#include "debug.h"
+#include "diagnostic.h"
+#include "opts.h"
+#include "machmode.h"
+#include "stor-layout.h" /* For layout_type */
+#include "vec.h"
+
+#include "a68.h"
+
+/* Global state for the Algol 68 front end.  */
+
+A68_T a68_common;
+
+/* The context to be used for global declarations.  */
+static GTY(()) tree global_context;
+
+/* Array of all global declarations to pass back to the middle-end.  */
+static GTY(()) vec <tree, va_gc> *global_declarations;
+
+/* Array of global type/decl nodes used by this front-end.  */
+
+tree a68_global_trees[ATI_MAX];
+
+/* Types expected by gcc's garbage collector.
+   These types exist to allow language front-ends to
+   add extra information in gcc's parse tree data structure. */
+
+struct GTY(()) lang_type
+{
+  MOID_T * GTY((skip)) moid;
+};
+
+struct GTY(()) lang_decl
+{
+  NODE_T * GTY((skip)) node;
+};
+
+/* Language-specific identifier information.  This must include a
+   tree_identifier.  */
+struct GTY(()) lang_identifier
+{
+  struct tree_identifier common;
+};
+
+
+struct GTY(()) language_function
+{
+  int dummy;
+};
+
+/* The Algol68 frontend Type AST for GCC type NODE.  */
+#define TYPE_LANG_FRONTEND(NODE) \
+  (TYPE_LANG_SPECIFIC (NODE) \
+   ? TYPE_LANG_SPECIFIC (NODE)->type : NULL)
+
+/* 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;
+};
+
+/* Allocate and return a lang specific structure for type tree nodes.  */
+
+struct lang_type *
+a68_build_lang_type (MOID_T *moid)
+{
+  tree ctype = CTYPE (moid);
+  struct lang_type *lt = ctype ? TYPE_LANG_SPECIFIC (ctype) : NULL;
+
+  if (lt == NULL)
+    lt = (struct lang_type *) ggc_cleared_alloc <struct lang_type> ();
+  if (lt->moid == NULL)
+    lt->moid = moid;
+  return lt;
+}
+
+/* Allocate and return a lang specific structure for decl tree nodes.  */
+
+struct lang_decl *
+a68_build_lang_decl (NODE_T *node)
+{
+  tree cdecl = CDECL (node);
+  struct lang_decl *ld = cdecl ? DECL_LANG_SPECIFIC (cdecl) : NULL;
+
+  if (ld == NULL)
+    ld = (struct lang_decl *) ggc_cleared_alloc <struct lang_decl> ();
+  if (ld->node == NULL)
+    ld->node = node;
+  return ld;
+}
+
+/* Get the front-end mode associated with the given TYPE.  If no mode is
+   associated then this function returns NO_MODE.  */
+
+MOID_T *
+a68_type_moid (tree type)
+{
+  gcc_assert (TYPE_LANG_SPECIFIC (type) != NULL
+	      && TYPE_LANG_SPECIFIC (type)->moid != NO_MOID);
+  return TYPE_LANG_SPECIFIC (type)->moid;
+}
+
+/* Build the type trees in a68_global_trees.  */
+
+static void
+a68_build_a68_type_nodes (void)
+{
+  /* VOID */
+  a68_void_type = make_node (RECORD_TYPE);
+  TYPE_NAME (a68_void_type) = get_identifier ("void%");
+  TYPE_FIELDS (a68_void_type) = NULL_TREE;
+  TYPE_READONLY (a68_void_type) = 1;
+  TYPE_CXX_ODR_P (a68_void_type) = 1;
+  layout_type (a68_void_type);
+
+  /* BOOL */
+  a68_bool_type = boolean_type_node;
+
+  /* CHAR */
+  a68_char_type = uint32_type_node;
+
+  /* SHORT SHORT INT
+     SHORT INT
+     INT */
+  a68_short_short_int_type = signed_char_type_node;
+  a68_short_int_type = short_integer_type_node;
+  a68_int_type = integer_type_node;
+
+  /* LONG INT */
+  if (int_size_in_bytes (long_integer_type_node)
+      > int_size_in_bytes (a68_int_type))
+    a68_long_int_type = long_integer_type_node;
+  else if (int_size_in_bytes (long_long_integer_type_node)
+	   > int_size_in_bytes (a68_int_type))
+    a68_long_int_type = long_long_integer_type_node;
+  else
+    a68_long_int_type = a68_int_type;
+
+  /* LONG LONG INT */
+  if (int_size_in_bytes (long_integer_type_node)
+      > int_size_in_bytes (a68_long_int_type))
+    a68_long_long_int_type = long_integer_type_node;
+  else if (int_size_in_bytes (long_long_integer_type_node)
+	   > int_size_in_bytes (a68_long_int_type))
+    a68_long_long_int_type = long_long_integer_type_node;
+  else
+    a68_long_long_int_type = a68_long_int_type;
+
+  /* SHORT SHORT BITS
+     SHORT BITS
+     BITS */
+  a68_short_short_bits_type = unsigned_char_type_node;
+  a68_short_bits_type = short_unsigned_type_node;
+  a68_bits_type = unsigned_type_node;
+
+  /* LONG BITS */
+  if (int_size_in_bytes (long_unsigned_type_node)
+      > int_size_in_bytes (a68_bits_type))
+    a68_long_bits_type = long_unsigned_type_node;
+  else if (int_size_in_bytes (long_long_unsigned_type_node)
+	   > int_size_in_bytes (a68_bits_type))
+    a68_long_bits_type = long_long_unsigned_type_node;
+  else
+    a68_long_bits_type = a68_bits_type;
+
+  /* LONG LONG BITS */
+  if (int_size_in_bytes (long_unsigned_type_node)
+      > int_size_in_bytes (a68_long_bits_type))
+    a68_long_long_bits_type = long_unsigned_type_node;
+  else if (int_size_in_bytes (long_long_unsigned_type_node)
+	   > int_size_in_bytes (a68_long_bits_type))
+    a68_long_long_bits_type = long_long_unsigned_type_node;
+  else
+    a68_long_long_bits_type = a68_long_bits_type;
+
+  /* BYTES
+     LONG BYTES */
+  a68_bytes_type = unsigned_type_node;
+  a68_long_bytes_type = long_unsigned_type_node;
+
+  /* REAL
+     LONG REAL
+     LONG LONG REAL */
+  a68_real_type = float_type_node;
+  a68_long_real_type = double_type_node;
+  a68_long_long_real_type = long_double_type_node;
+}
+
+/* Language hooks data structures.  This is the main interface between
+   the GCC front-end and the GCC middle-end/back-end.  A list of
+   language hooks can be found in langhooks.h.  */
+
+#undef LANG_HOOKS_NAME
+#define LANG_HOOKS_NAME "GNU Algol 68"
+
+/* LANG_HOOKS_INIT gets called to initialize the front-end.
+   Invoked after option handling.  */
+
+static bool
+a68_init (void)
+{
+  build_common_tree_nodes (false);
+  targetm.init_builtins ();
+  a68_build_a68_type_nodes ();
+  build_common_builtin_nodes ();
+  a68_install_builtins ();
+
+  /* Initialize binding contexts.  */
+  a68_init_ranges ();
+
+  /* Set the type of size_t.  */
+  if (TYPE_MODE (long_unsigned_type_node) == ptr_mode)
+    size_type_node = long_unsigned_type_node;
+  else if (TYPE_MODE (long_long_unsigned_type_node) == ptr_mode)
+    size_type_node = long_long_unsigned_type_node;
+  else
+    size_type_node = long_unsigned_type_node;
+
+  return true;
+}
+
+#undef LANG_HOOKS_INIT
+#define LANG_HOOKS_INIT a68_init
+
+/* LANG_HOOKS_OPTION_LANG_MASK  */
+
+static unsigned int
+a68_option_lang_mask (void)
+{
+  return CL_Algol68;
+}
+
+#undef LANG_HOOKS_OPTION_LANG_MASK
+#define LANG_HOOKS_OPTION_LANG_MASK a68_option_lang_mask
+
+
+/* Return a data type that has machine mode MODE.  If the mode is an
+   integer, then UNSIGNEDP selects between signed and unsigned types.  */
+
+static tree
+a68_type_for_mode (enum machine_mode mode, int unsignedp)
+{
+  if (mode == QImode)
+    return unsignedp ? a68_short_short_bits_type :a68_short_short_int_type;
+
+  if (mode == HImode)
+    return unsignedp ? a68_short_bits_type : a68_short_int_type;
+
+  if (mode == SImode)
+    return unsignedp ? a68_bits_type : a68_int_type;
+
+  if (mode == DImode)
+    return unsignedp ? a68_long_bits_type : a68_long_int_type;
+
+  if (mode == TYPE_MODE (a68_long_long_bits_type))
+    return unsignedp ? a68_long_long_bits_type : a68_long_long_int_type;
+
+  if (mode == TYPE_MODE (a68_real_type))
+    return a68_real_type;
+
+  if (mode == TYPE_MODE (a68_long_real_type))
+    return a68_long_real_type;
+
+  if (mode == TYPE_MODE (a68_long_long_real_type))
+    return a68_long_long_real_type;
+
+  if (mode == TYPE_MODE (build_pointer_type (char_type_node)))
+    return build_pointer_type (char_type_node);
+
+  if (mode == TYPE_MODE (build_pointer_type (integer_type_node)))
+    return build_pointer_type (integer_type_node);
+
+  for (int i = 0; i < NUM_INT_N_ENTS; i ++)
+    {
+      if (int_n_enabled_p[i] && mode == int_n_data[i].m)
+	{
+	  if (unsignedp)
+	    return int_n_trees[i].unsigned_type;
+	  else
+	    return int_n_trees[i].signed_type;
+	}
+    }
+
+  return 0;
+}
+
+#undef LANG_HOOKS_TYPE_FOR_MODE
+#define LANG_HOOKS_TYPE_FOR_MODE a68_type_for_mode
+
+
+/* Return an integer type with BITS bits of precision,
+   that is unsigned if UNSIGNEDP is nonzero, otherwise signed.  */
+
+static tree
+a68_type_for_size (unsigned int bits, int unsignedp)
+{
+  if (unsignedp)
+    {
+      if (bits <= TYPE_PRECISION (a68_short_short_bits_type))
+	return a68_short_short_bits_type;
+      if (bits <= TYPE_PRECISION (a68_short_bits_type))
+	return a68_short_bits_type;
+      if (bits <= TYPE_PRECISION (a68_bits_type))
+	return a68_bits_type;
+      if (bits <= TYPE_PRECISION (a68_long_bits_type))
+	return a68_long_bits_type;
+      if (bits <= TYPE_PRECISION (a68_long_long_bits_type))
+	return a68_long_long_bits_type;
+    }
+  else
+    {
+      if (bits <= TYPE_PRECISION (a68_short_short_int_type))
+	return a68_short_short_int_type;
+      if (bits <= TYPE_PRECISION (a68_short_int_type))
+	return a68_short_int_type;
+      if (bits <= TYPE_PRECISION (a68_int_type))
+	return a68_int_type;
+      if (bits <= TYPE_PRECISION (a68_long_int_type))
+	return a68_long_int_type;
+      if (bits <= TYPE_PRECISION (a68_long_long_int_type))
+	return a68_long_long_int_type;
+    }
+
+  for (int i = 0; i < NUM_INT_N_ENTS; ++i)
+    {
+      if (int_n_enabled_p[i] && bits == int_n_data[i].bitsize)
+	{
+	  if (unsignedp)
+	    return int_n_trees[i].unsigned_type;
+	  else
+	    return int_n_trees[i].signed_type;
+	}
+    }
+
+  return 0;
+}
+
+#undef LANG_HOOKS_TYPE_FOR_SIZE
+#define LANG_HOOKS_TYPE_FOR_SIZE a68_type_for_size
+
+
+/* Implements the lang_hooks.decls.global_bindings_p routine for Algol 68.
+   Return true if we are in the global binding level.  */
+
+static bool
+a68_global_bindings_p (void)
+{
+  return (current_function_decl == NULL_TREE);
+}
+
+#undef LANG_HOOKS_GLOBAL_BINDINGS_P
+#define LANG_HOOKS_GLOBAL_BINDINGS_P a68_global_bindings_p
+
+/* Implements the lang_hooks.decls.getdecls routine.
+   Return the list of declarations of the current level.  */
+
+static tree
+a68_getdecls (void)
+{
+  return a68_range_names ();
+}
+
+#undef LANG_HOOKS_GETDECLS
+#define LANG_HOOKS_GETDECLS a68_getdecls
+
+/* Return global_context, but create it first if need be.  */
+
+static tree
+get_global_context (void)
+{
+  if (!global_context)
+    {
+      global_context = build_translation_unit_decl (NULL_TREE);
+      debug_hooks->register_main_translation_unit (global_context);
+    }
+
+  return global_context;
+}
+
+/* Implements the lang_hooks.decls.pushdecl routine.
+   Record DECL as belonging to the current lexical scope.  */
+
+static tree
+pushdecl (tree decl)
+{
+  /* Set the context of the decl.  If current_function_decl did not help in
+     determining the context, use global scope.  */
+  if (!DECL_CONTEXT (decl))
+    {
+      if (current_function_decl)
+	DECL_CONTEXT (decl) = current_function_decl;
+      else
+	DECL_CONTEXT (decl) = get_global_context ();
+    }
+
+  /* Put decls on list in reverse order.  */
+  if (TREE_STATIC (decl) || a68_global_bindings_p ())
+    vec_safe_push (global_declarations, decl);
+  else
+    a68_add_decl (decl);
+
+  return decl;
+}
+
+#undef LANG_HOOKS_PUSHDECL
+#define LANG_HOOKS_PUSHDECL pushdecl
+
+/* Implements the lang_hooks.init_options routine for language Algol 68.  This
+   initializes the global state for the frontend before calling the option
+   handlers.  */
+
+static void
+a68_init_options (unsigned int argc ATTRIBUTE_UNUSED,
+		  cl_decoded_option *decoded_options ATTRIBUTE_UNUSED)
+{
+  /* Nothing to do here for now.  */
+}
+
+#undef LANG_HOOKS_INIT_OPTIONS
+#define LANG_HOOKS_INIT_OPTIONS	a68_init_options
+
+/* Handle Algol 68 specific options.  Return false if we didn't do
+   anything.  */
+
+static bool
+a68_handle_option (size_t scode,
+		   const char *arg,
+		   HOST_WIDE_INT value ATTRIBUTE_UNUSED,
+		   int kind ATTRIBUTE_UNUSED,
+		   location_t loc ATTRIBUTE_UNUSED,
+		   const cl_option_handlers *handlers ATTRIBUTE_UNUSED)
+{
+  opt_code code = (opt_code) scode;
+
+  switch (code)
+    {
+    case OPT_std_algol68:
+      OPTION_STRICT (&A68_JOB) = 1;
+      break;
+    case OPT_fa68_brackets:
+      OPTION_BRACKETS (&A68_JOB) = flag_a68_brackets;
+      break;
+    case OPT_fa68_assert:
+      OPTION_ASSERT (&A68_JOB) = flag_a68_assert;
+      break;
+    case OPT_fa68_bounds_checking:
+      OPTION_BOUNDS_CHECKING (&A68_JOB) = flag_a68_bounds_checking;
+      break;
+    case OPT_fa68_nil_checking:
+      OPTION_NIL_CHECKING (&A68_JOB) = flag_a68_nil_checking;
+      break;
+    case OPT_fstropping_:
+      if (value == 0)
+	OPTION_STROPPING (&A68_JOB) = UPPER_STROPPING;
+      else
+	OPTION_STROPPING (&A68_JOB) = SUPPER_STROPPING;
+      break;
+    case OPT_I:
+      vec_safe_push (A68_INCLUDE_PATHS, arg);
+      break;
+    default:
+      break;
+    }
+
+  return true;
+}
+
+#undef LANG_HOOKS_HANDLE_OPTION
+#define LANG_HOOKS_HANDLE_OPTION a68_handle_option
+
+/* LANG_HOOKS_INIT_OPTIONS_STRUCT is called so the front-end can
+   change some default values in the compiler's option structure.  */
+
+static void
+a68_init_options_struct (struct gcc_options *opts)
+{
+  /* Operations are always wrapping in algol68, even on signed
+     integer.  */
+  opts->x_flag_wrapv = 1;
+  /* Be safe by default.  */
+  opts->x_flag_a68_safe = 0;
+  /* Do not warn for voiding by default.  */
+  opts->x_warn_algol68_voiding = 0;
+  /* Do not warn for usage of Algol 68 extensions by default.  */
+  opts->x_warn_algol68_extensions = 0;
+  /* Do not warn for potential scope violations by default.  */
+  opts->x_warn_algol68_scope = 0;
+  /* Do not warn for hidden declarations by default.  */
+  opts->x_warn_algol68_hidden_declarations = 0;
+  /* Enable assertions by default.  */
+  OPTION_ASSERT (&A68_JOB) = 1;
+  /* Disable run-time nil checking by default.  */
+  OPTION_NIL_CHECKING (&A68_JOB) = 0;
+  /* Enable run-time bounds checking by default.  */
+  OPTION_BOUNDS_CHECKING (&A68_JOB) = 1;
+  opts->x_flag_a68_assert = 1;
+  /* Allow GNU extensions by default.  */
+  OPTION_STRICT (&A68_JOB) = 0;
+  /* The default stropping regime is SUPPER.  */
+  OPTION_STROPPING (&A68_JOB) = SUPPER_STROPPING;
+}
+
+#undef LANG_HOOKS_INIT_OPTIONS_STRUCT
+#define LANG_HOOKS_INIT_OPTIONS_STRUCT a68_init_options_struct
+
+/* Deal with any options that imply the turning on/off of features.  FILENAME
+   is the main input file passed on the command line.  */
+
+static bool
+a68_post_options (const char **filename ATTRIBUTE_UNUSED)
+{
+  return false;
+}
+
+#undef LANG_HOOKS_POST_OPTIONS
+#define LANG_HOOKS_POST_OPTIONS	a68_post_options
+
+/* LANG_HOOKS_PARSE_FILE is called to parse the input files.
+
+   The input file names are available in the global variables
+   in_fnames and num_in_fnames, and this function is required to
+   create a complete parse tree from them in a global var, then
+   return.  */
+
+static void
+a68_parse_file (void)
+{
+  if (num_in_fnames != 1)
+    fatal_error (UNKNOWN_LOCATION,
+		 "exactly one source file must be specified on the command line");
+
+  /* Run the Mailloux parser.  */
+  a68_parser (in_fnames[0]);
+
+  if (ERROR_COUNT (&A68_JOB) > 0)
+    goto had_errors;
+
+  /* Generate dumps if so requested.  */
+  if (flag_dump_algol68_modes)
+    a68_dump_modes (TOP_MOID (&A68_JOB));
+  if (flag_dump_algol68_tree)
+    a68_dump_parse_tree (TOP_NODE (&A68_JOB));
+
+  /* Lower modes to GENERIC.  */
+  a68_lower_moids (TOP_MOID (&A68_JOB));
+  /* Lower the particular program.  */
+  a68_lower_top_tree (TOP_NODE (&A68_JOB));
+
+  if (ERROR_COUNT (&A68_JOB) > 0)
+    goto had_errors;
+
+  /* Process all file scopes in this compilation, and the external_scope,
+     through wrapup_global_declarations.  */
+  for (unsigned int i = 0; i < vec_safe_length (global_declarations); i++)
+    {
+      tree decl = vec_safe_address (global_declarations)[i];
+      wrapup_global_declarations (&decl, 1);
+    }
+
+ had_errors:
+  errorcount += ERROR_COUNT (&A68_JOB);
+}
+
+#undef LANG_HOOKS_PARSE_FILE
+#define LANG_HOOKS_PARSE_FILE a68_parse_file
+
+/* This hook is called for every GENERIC tree that gets gimplified.
+   Its purpose is to gimplify language specific trees.
+
+   At the moment we are not supporting any Algol 68 specific tree, so
+   we just return FALSE.  */
+
+static int
+a68_gimplify_expr (tree *expr_p ATTRIBUTE_UNUSED,
+                   gimple_seq *pre_p ATTRIBUTE_UNUSED,
+                   gimple_seq *post_p ATTRIBUTE_UNUSED)
+{
+  return false;
+}
+
+#undef LANG_HOOKS_GIMPLIFY_EXPR
+#define LANG_HOOKS_GIMPLIFY_EXPR a68_gimplify_expr
+
+/* This function shall return the printable name of the language.  */
+
+static const char *
+a68_printable_name (tree decl, int kind ATTRIBUTE_UNUSED)
+{
+  tree decl_name = DECL_NAME (decl);
+
+  if (decl_name == NULL_TREE)
+    return "<unnamed>";
+  else
+    return IDENTIFIER_POINTER (decl_name);
+}
+
+#undef LANG_HOOKS_DECL_PRINTABLE_NAME
+#define LANG_HOOKS_DECL_PRINTABLE_NAME a68_printable_name
+
+
+/* Return true if a warning should be given about option OPTION, which is for
+   the wrong language, false if it should be quietly ignored.  */
+
+static bool
+a68_complain_wrong_lang_p (const struct cl_option *option ATTRIBUTE_UNUSED)
+{
+  return false;
+}
+
+#undef LANG_HOOKS_COMPLAIN_WRONG_LANG_P
+#define LANG_HOOKS_COMPLAIN_WRONG_LANG_P a68_complain_wrong_lang_p
+
+/* Create an expression whose value is that of EXPR,
+   converted to type TYPE.  The TREE_TYPE of the value
+   is always TYPE.  This function implements all reasonable
+   conversions; callers should filter out those that are
+   not permitted by the language being compiled.
+
+   Note that this function is not used outside the front-end.  This front-end
+   doesn't currently use it at all.  */
+
+tree convert (tree type ATTRIBUTE_UNUSED,
+	      tree expr ATTRIBUTE_UNUSED)
+{
+  gcc_unreachable ();
+}
+
+/* Implements the lang_hooks.types_compatible_p routine for Algol 68.
+   Compares two types for equivalence in Algol 68.
+   This routine should only return 1 if it is sure, even though the frontend
+   should have already ensured that all types are compatible before handing
+   over the parsed ASTs to the code generator.  */
+
+static int
+a68_types_compatible_p (tree x, tree y)
+{
+  MOID_T *mode_x = a68_type_moid (x);
+  MOID_T *mode_y = a68_type_moid (y);
+
+  if (mode_x != NO_MOID && mode_y != NO_MOID)
+    return a68_is_equal_modes (mode_x, mode_y, SAFE_DEFLEXING);
+
+  return false;
+}
+
+#undef LANG_HOOKS_TYPES_COMPATIBLE_P
+#define LANG_HOOKS_TYPES_COMPATIBLE_P a68_types_compatible_p
+
+/* Get a value for the SARIF v2.1.0 "artifact.sourceLanguage" property.  Algol
+   68 is not yet listed in SARIF v2.1.0 Appendix J, but if/when it does, it
+   will likely use this string.  */
+
+const char *
+a68_get_sarif_source_language (const char *)
+{
+  return "algol68";
+}
+
+#undef LANG_HOOKS_GET_SARIF_SOURCE_LANGUAGE
+#define LANG_HOOKS_GET_SARIF_SOURCE_LANGUAGE a68_get_sarif_source_language
+
+/* Expands all LANG_HOOKS_x o GCC.  */
+struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+
+#include "gt-algol68-a68-lang.h"
+#include "gtype-algol68.h"
--- /dev/null
+++ b/src/gcc/algol68/a68-low-bits.cc
@@ -0,0 +1,297 @@
+/* Lowering routines for all things related to BITS values.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielind of SKIP for the given BITS mode.  */
+
+tree
+a68_get_bits_skip_tree (MOID_T *m)
+{
+  tree type;
+
+  if (m == M_BITS)
+    type = a68_bits_type;
+  else if (m == M_LONG_BITS)
+    type = a68_long_bits_type;
+  else if (m == M_LONG_LONG_BITS)
+    type = a68_long_long_bits_type;
+  else if (m == M_SHORT_BITS)
+    type = a68_short_bits_type;
+  else if (m == M_SHORT_SHORT_BITS)
+    type = a68_short_short_bits_type;
+  else
+    gcc_unreachable ();
+
+  return build_int_cst (type, 0);
+}
+
+/* Given a BITS type, compute the number of bits that fit in a value of that
+   type.  The result is an INT.  */
+
+tree
+a68_bits_width (tree type)
+{
+  return fold_convert (a68_int_type, TYPE_SIZE (type));
+}
+
+/* Given a BITS type, compute the maximum value that can be expressed with that
+   type.  */
+
+tree
+a68_bits_maxbits (tree type)
+{
+  return fold_convert (type, TYPE_MAX_VALUE (type));
+}
+
+/* Given a SIZETY INT value VAL, compute and return a SIZETY BITS reflecting
+   its constituent bits.
+
+   In strict Algol 68 the BIN of a negative value is BITS (SKIP).
+
+   In GNU 68 the BIN of a negative value is the constituent bits of the two's
+   complement of the value.  */
+
+tree
+a68_bits_bin (MOID_T *m, tree val)
+{
+  tree type = CTYPE (m);
+
+  if (OPTION_STRICT (&A68_JOB))
+    return a68_get_bits_skip_tree (m);
+  else
+    return fold_convert (type, val);
+}
+
+/* Given a SIZETY BITS value BITS, compute and return the corresponding SIZETY
+   INT.
+
+   In strict Algol 68 the ABS of a BITS value reflecting a bit pattern that
+   would correspond a negative integral value is INT (SKIP).
+
+   In GNU 68 the ABS of a BITS value reflecting a bit pattern that would
+   correspond a negative integral value is that negative integral value.  */
+
+tree
+a68_bits_abs (MOID_T *m, tree bits)
+{
+  tree type = CTYPE (m);
+
+  if (OPTION_STRICT (&A68_JOB))
+    {
+      tree integral_val = save_expr (fold_convert (type, bits));
+      return fold_build3 (COND_EXPR,
+			  type,
+			  fold_build2 (LT_EXPR, type, integral_val,
+				       build_int_cst (type, 0)),
+			  a68_get_int_skip_tree (m),
+			  integral_val);
+    }
+  else
+    return fold_convert (type, bits);
+}
+
+/* Given a SIZETY BITS value BITS, shorten it into a SIZETY BITS whose tree
+   type is TYPE.  */
+
+tree
+a68_bits_shorten (tree type, tree bits)
+{
+  /* This will truncate at the left, which is what is intended.  */
+  return fold_convert (type, bits);
+}
+
+/* Given a SIZETY BITS value BITS, length it into a SIZETY BITS whose tree type
+   is TYPE.  */
+
+tree
+a68_bits_leng (tree type, tree bits)
+{
+  /* This will add zeroes to the left, which is what is intended.  */
+  return fold_convert (type, bits);
+}
+
+/* Given a SIZETY BITS value BITS, compute and return a new SIZETY BITS whose
+   bits are the logical negation of the bits of BITS.  */
+
+tree
+a68_bits_not (tree bits)
+{
+  return fold_build1 (BIT_NOT_EXPR, TREE_TYPE (bits), bits);
+}
+
+/* Given two SIZETY BITS values BITS1 and BITS2, compute and return a new
+   SIZETY BITS whose bits are the `and' of the bits of BITS1 and
+   BITS2.  */
+
+tree
+a68_bits_and (tree bits1, tree bits2)
+{
+  return fold_build2 (BIT_AND_EXPR, TREE_TYPE (bits1), bits1, bits2);
+}
+
+/* Given two SIZETY BITS values BITS1 and BITS2, compute and return a new
+   SIZETY BITS whose bits are the inclusive-or of the bits of BITS1 and
+   BITS2.  */
+
+tree
+a68_bits_ior (tree bits1, tree bits2)
+{
+  return fold_build2 (BIT_IOR_EXPR, TREE_TYPE (bits1), bits1, bits2);
+}
+
+/* Given two SIZETY BITS values BITS1 and BITS2, compute and return a new
+   SIZETY BITS whose bits are the exclusive-or of the bits of BITS1 and
+   BITS2.  */
+
+tree
+a68_bits_xor (tree bits1, tree bits2)
+{
+  return fold_build2 (BIT_XOR_EXPR, TREE_TYPE (bits1), bits1, bits2);
+}
+
+/* Given a position POS of mode INT and a BITS of mode SIZETY BITS, return a
+   BOOL reflecting the state of the bit occupying the position POS in BITS.
+
+   If POS is out of range a run-time error is emitted.  */
+
+tree
+a68_bits_elem (NODE_T *p, tree pos, tree bits)
+{
+  pos = save_expr (pos);
+  tree one = build_int_cst (TREE_TYPE (bits), 1);
+
+  tree shift = fold_build2 (MINUS_EXPR, bitsizetype,
+			    TYPE_SIZE (TREE_TYPE (bits)),
+			    fold_convert (bitsizetype, pos));
+  tree elem = fold_build2 (EQ_EXPR,
+			   a68_bool_type,
+			   fold_build2 (BIT_AND_EXPR,
+					TREE_TYPE (bits),
+					fold_build2 (RSHIFT_EXPR,
+						     TREE_TYPE (bits),
+						     bits, shift),
+					one),
+			   one);
+
+  /* Do bounds checking if requested.  */
+  if (OPTION_BOUNDS_CHECKING (&A68_JOB))
+    {
+      unsigned int lineno = NUMBER (LINE (INFO (p)));
+      const char *filename_str = FILENAME (LINE (INFO (p)));
+      tree filename = build_string_literal (strlen (filename_str) + 1,
+					    filename_str);
+      tree call = a68_build_libcall (A68_LIBCALL_BITSBOUNDSERROR,
+				     void_type_node, 3,
+				     filename,
+				     build_int_cst (unsigned_type_node, lineno),
+				     fold_convert (ssizetype, pos));
+      tree check = fold_build2 (TRUTH_AND_EXPR, integer_type_node,
+				fold_build2 (GT_EXPR, integer_type_node,
+					     pos, fold_convert (TREE_TYPE (pos), integer_zero_node)),
+				fold_build2 (LE_EXPR, integer_type_node,
+					     fold_convert (bitsizetype, pos),
+					     TYPE_SIZE (TREE_TYPE (bits))));
+
+      check = fold_build2_loc (a68_get_node_location (p),
+			       TRUTH_ORIF_EXPR,
+			       ssizetype,
+			       check,
+			       fold_build2 (COMPOUND_EXPR, a68_bool_type,
+					    call, boolean_false_node));
+      elem = fold_build2 (COMPOUND_EXPR, a68_bool_type,
+			  check, elem);
+    }
+
+  return elem;
+}
+
+/* Given two SIZETY BITS values BITS1 and BITS2, return a BOOL value indicating
+   whether all the bits set in BITS1 are also set in BITS2.  */
+
+tree
+a68_bits_subset (tree bits1, tree bits2)
+{
+  /* We compute this operation with `A | B == B' as specified by the Report */
+  bits2 = save_expr (bits2);
+  return fold_build2 (EQ_EXPR, a68_bool_type,
+		      fold_build2 (BIT_IOR_EXPR, TREE_TYPE (bits1), bits1, bits2),
+		      bits2);
+}
+
+/* Rotate the bits in BITS SHIFT bits to the left if SHIFT is positive, or ABS
+   (SHIFT) bits to the right if SHIFT is negative.
+
+   A run-time error is raised if the count overflows the BITS value.  */
+
+tree
+a68_bits_shift (tree shift, tree bits)
+{
+  shift = save_expr (shift);
+  bits = save_expr (bits);
+  return fold_build3 (COND_EXPR,
+		      TREE_TYPE (bits),
+		      fold_build2 (GE_EXPR, TREE_TYPE (shift),
+				   shift, build_int_cst (TREE_TYPE (shift), 0)),
+		      fold_build2 (LSHIFT_EXPR, TREE_TYPE (bits),
+				   bits, shift),
+		      fold_build2 (RSHIFT_EXPR, TREE_TYPE (bits),
+				   bits,
+				   fold_build1 (ABS_EXPR, TREE_TYPE (shift), shift)));
+}
+
+/* Given two bits values, build an expression that calculates whether A = B.  */
+
+tree
+a68_bits_eq (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two bits values, build an expression that calculates whether A /=
+   B.  */
+
+tree
+a68_bits_ne (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-bools.cc
@@ -0,0 +1,77 @@
+/* Lowering routines for all things related to BOOL values.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielind of SKIP of a BOOL mode.  */
+
+tree
+a68_get_bool_skip_tree (void)
+{
+  return build_int_cst (a68_bool_type, 0);
+}
+
+/* The absolute value of a BOOL is a non-zero INT for TRUE and zero for
+   FALSE.  */
+
+tree
+a68_bool_abs (tree val)
+{
+  return fold_convert (a68_int_type, val);
+}
+
+/* Given two boolean values, build an expression that calculates whether A = B.  */
+
+tree
+a68_bool_eq (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two boolean values, build an expression that calculates whether A /=
+   B.  */
+
+tree
+a68_bool_ne (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-builtins.cc
@@ -0,0 +1,533 @@
+/* GCC built-ins support for Algol 68.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Define a built-in function.  */
+
+static void
+local_define_builtin (const char *name, tree type, enum built_in_function code,
+                      const char *library_name, int ecf_flags)
+{
+  tree decl;
+
+  decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
+			       library_name, NULL_TREE);
+  set_call_expr_flags (decl, ecf_flags);
+  set_builtin_decl (code, decl, true);
+}
+
+/* Install the GCC built-ins so the front-end can use them.  */
+
+void
+a68_install_builtins (void)
+{
+  if (!builtin_decl_explicit_p (BUILT_IN_IROUNDF))
+    {
+      tree ftype = build_function_type_list (integer_type_node,
+					     float_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_iroundf", ftype, BUILT_IN_IROUNDF,
+			    "iroundf", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LROUNDF))
+    {
+      tree ftype = build_function_type_list (long_integer_type_node,
+					     float_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_lroundf", ftype, BUILT_IN_LROUNDF,
+			    "lroundf", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LLROUNDF))
+    {
+      tree ftype = build_function_type_list (long_long_integer_type_node,
+					     float_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_llroundf", ftype, BUILT_IN_LLROUNDF,
+			    "llroundf", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_IROUND))
+    {
+      tree ftype = build_function_type_list (integer_type_node,
+					     double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_iround", ftype, BUILT_IN_IROUND,
+			    "iround", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LROUND))
+    {
+      tree ftype = build_function_type_list (long_integer_type_node,
+					     double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_lround", ftype, BUILT_IN_LROUND,
+			    "lround", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LLROUND))
+    {
+      tree ftype = build_function_type_list (long_long_integer_type_node,
+					     double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_llround", ftype, BUILT_IN_LLROUND,
+			    "llround", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_IROUNDL))
+    {
+      tree ftype = build_function_type_list (integer_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_iroundl", ftype, BUILT_IN_IROUNDL,
+			    "iroundl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LROUNDL))
+    {
+      tree ftype = build_function_type_list (long_integer_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_lroundl", ftype, BUILT_IN_LROUNDL,
+			    "lroundl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LLROUNDL))
+    {
+      tree ftype = build_function_type_list (long_long_integer_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_llroundl", ftype, BUILT_IN_LLROUNDL,
+			    "llroundl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_IFLOORF))
+    {
+      tree ftype = build_function_type_list (integer_type_node,
+					     float_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_ifloorf", ftype, BUILT_IN_IFLOORF,
+			    "ifloorf", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LFLOORF))
+    {
+      tree ftype = build_function_type_list (long_integer_type_node,
+					     float_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_lfloorf", ftype, BUILT_IN_LFLOORF,
+			    "lfloorf", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LLFLOORF))
+    {
+      tree ftype = build_function_type_list (long_long_integer_type_node,
+					     float_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_llfloorf", ftype, BUILT_IN_LLFLOORF,
+			    "llfloorf", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_IFLOOR))
+    {
+      tree ftype = build_function_type_list (integer_type_node,
+					     double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_ifloor", ftype, BUILT_IN_IFLOOR,
+			    "ifloor", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LFLOOR))
+    {
+      tree ftype = build_function_type_list (long_integer_type_node,
+					     double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_lfloor", ftype, BUILT_IN_LFLOOR,
+			    "lfloor", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LLFLOOR))
+    {
+      tree ftype = build_function_type_list (long_long_integer_type_node,
+					     double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_llfloor", ftype, BUILT_IN_LLFLOOR,
+			    "llfloor", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_IFLOORL))
+    {
+      tree ftype = build_function_type_list (integer_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_ifloorl", ftype, BUILT_IN_IFLOORL,
+			    "ifloorl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LFLOORL))
+    {
+      tree ftype = build_function_type_list (long_integer_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_lfloorl", ftype, BUILT_IN_LFLOORL,
+			    "lfloorl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LLFLOORL))
+    {
+      tree ftype = build_function_type_list (long_long_integer_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_llfloorl", ftype, BUILT_IN_LLFLOORL,
+			    "llfloorl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_POWF))
+    {
+      tree ftype = build_function_type_list (float_type_node,
+					     float_type_node, float_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_powf", ftype, BUILT_IN_POWF,
+			    "powf", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_POWIF))
+    {
+      tree ftype = build_function_type_list (float_type_node,
+					     float_type_node, integer_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_powif", ftype, BUILT_IN_POWIF,
+			    "powif", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_POW))
+    {
+      tree ftype = build_function_type_list (double_type_node,
+					     double_type_node, double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_pow", ftype, BUILT_IN_POW,
+			    "pow", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_POWI))
+    {
+      tree ftype = build_function_type_list (double_type_node,
+					     double_type_node, integer_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_powi", ftype, BUILT_IN_POWI,
+			    "powi", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_POWL))
+    {
+      tree ftype = build_function_type_list (long_double_type_node,
+					     long_double_type_node, long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_powl", ftype, BUILT_IN_POWL,
+			    "powl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_POWIL))
+    {
+      tree ftype = build_function_type_list (long_double_type_node,
+					     long_double_type_node, integer_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_powil", ftype, BUILT_IN_POWIL,
+			    "powil", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_CALLOC))
+    {
+      tree ftype = build_function_type_list (ptr_type_node,
+					     size_type_node, size_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_calloc", ftype, BUILT_IN_CALLOC,
+			    "calloc", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_MEMCPY))
+    {
+      tree ftype = build_function_type_list (ptr_type_node,
+					     ptr_type_node, const_ptr_type_node, size_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_memcpy", ftype, BUILT_IN_MEMSET,
+			    "memcpy", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_MEMSET))
+    {
+      tree ftype = build_function_type_list (ptr_type_node,
+					     ptr_type_node, integer_type_node, size_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_memset", ftype, BUILT_IN_MEMSET,
+			    "memset", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_SQRTF))
+    {
+      tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_sqrtf", ftype, BUILT_IN_SQRTF,
+			    "sqrtf", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_SQRT))
+    {
+      tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_sqrt", ftype, BUILT_IN_SQRT,
+			    "sqrt", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_SQRTL))
+    {
+      tree ftype = build_function_type_list (long_double_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_sqrtl", ftype, BUILT_IN_SQRTL,
+			    "sqrtl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_TANF))
+    {
+      tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_tanf", ftype, BUILT_IN_TANF,
+			    "tanf", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_TAN))
+    {
+      tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_tan", ftype, BUILT_IN_TAN,
+			    "tan", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_TANL))
+    {
+      tree ftype = build_function_type_list (long_double_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_tanl", ftype, BUILT_IN_TANL,
+			    "tanl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_SINF))
+    {
+      tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_sinf", ftype, BUILT_IN_SINF,
+			    "sinf", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_SIN))
+    {
+      tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_sin", ftype, BUILT_IN_SIN,
+			    "sin", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_SINL))
+    {
+      tree ftype = build_function_type_list (long_double_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_sinl", ftype, BUILT_IN_SINL,
+			    "sinl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_COSF))
+    {
+      tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_cosf", ftype, BUILT_IN_COSF,
+			    "cosf", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_COS))
+    {
+      tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_cos", ftype, BUILT_IN_COS,
+			    "cos", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_COSL))
+    {
+      tree ftype = build_function_type_list (long_double_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_cosl", ftype, BUILT_IN_COSL,
+			    "cosl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_ACOSF))
+    {
+      tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_acosf", ftype, BUILT_IN_ACOSF,
+			    "acosf", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_ACOS))
+    {
+      tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_acos", ftype, BUILT_IN_ACOS,
+			    "acos", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_ACOSL))
+    {
+      tree ftype = build_function_type_list (long_double_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_acosl", ftype, BUILT_IN_ACOSL,
+			    "acosl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_ASINF))
+    {
+      tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_asinf", ftype, BUILT_IN_ASINF,
+			    "asinf", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_ASIN))
+    {
+      tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_asin", ftype, BUILT_IN_ASIN,
+			    "asin", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_ASINL))
+    {
+      tree ftype = build_function_type_list (long_double_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_asinl", ftype, BUILT_IN_ASINL,
+			    "asinl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_ATANF))
+    {
+      tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_atanf", ftype, BUILT_IN_ATANF,
+			    "atanf", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_ATAN))
+    {
+      tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_atan", ftype, BUILT_IN_ATAN,
+			    "atan", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_ATANL))
+    {
+      tree ftype = build_function_type_list (long_double_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_atanl", ftype, BUILT_IN_ATANL,
+			    "atanl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LOGF))
+    {
+      tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_logf", ftype, BUILT_IN_LOGF,
+			    "logf", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LOG))
+    {
+      tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_log", ftype, BUILT_IN_LOG,
+			    "log", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LOGL))
+    {
+      tree ftype = build_function_type_list (long_double_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_logl", ftype, BUILT_IN_LOGL,
+			    "logl", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LOG10F))
+    {
+      tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_log10f", ftype, BUILT_IN_LOG10F,
+			    "log10f", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LOG10))
+    {
+      tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_log10", ftype, BUILT_IN_LOG10,
+			    "log10", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_LOG10L))
+    {
+      tree ftype = build_function_type_list (long_double_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_log10l", ftype, BUILT_IN_LOG10L,
+			    "log10l", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_EXPF))
+    {
+      tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_expf", ftype, BUILT_IN_EXPF,
+			    "expf", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_EXP))
+    {
+      tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE);
+      local_define_builtin ("__builtin_exp", ftype, BUILT_IN_EXP,
+			    "exp", ECF_NOTHROW | ECF_LEAF);
+    }
+
+  if (!builtin_decl_explicit_p (BUILT_IN_EXPL))
+    {
+      tree ftype = build_function_type_list (long_double_type_node,
+					     long_double_type_node,
+					     NULL_TREE);
+      local_define_builtin ("__builtin_expl", ftype, BUILT_IN_EXPL,
+			    "expl", ECF_NOTHROW | ECF_LEAF);
+    }
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-chars.cc
@@ -0,0 +1,170 @@
+/* Lowering routines for all things related to STRINGs.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielind of SKIP of a CHAR mode.  */
+
+tree
+a68_get_char_skip_tree (void)
+{
+  return build_int_cst (a68_char_type, ' ');
+}
+
+/* Return the maximum valid character code that can be stored in a CHAR.  */
+tree
+a68_char_max (void)
+{
+  /* 0x10FFFF is the maximum valid code point in Unicode.  */
+  return build_int_cst (a68_char_type, 0x10FFFF);
+}
+
+/* Given an integral value, if it denotes a char code build the corresponding
+   CHAR.  Otherwise raise a run-time error.  */
+
+tree
+a68_char_repr (NODE_T *p, tree val)
+{
+  /* UCS-4 (UTF-32) encodes the Unicode code points using the identity
+     function.  Valid code points are in the ranges [U+0000,U+D7FF] and
+     [U+E000,U+10FFFF].  */
+
+  tree c = save_expr (val);
+  tree val_type = TREE_TYPE (val);
+
+  /* (c >= 0 && c < 0xd800) */
+  tree range1 = fold_build2 (TRUTH_AND_EXPR, integer_type_node,
+			     fold_build2 (GE_EXPR, integer_type_node,
+					  c, fold_convert (val_type, integer_zero_node)),
+			     fold_build2 (LT_EXPR, integer_type_node,
+					  c, build_int_cst (val_type, 0xd800)));
+  /* (c >= 0xe000 && c < 0x110000) */
+  tree range2 = fold_build2 (TRUTH_AND_EXPR, integer_type_node,
+			     fold_build2 (GE_EXPR, integer_type_node,
+					  c, build_int_cst (val_type, 0xe000)),
+			     fold_build2 (LT_EXPR, integer_type_node,
+					  c, build_int_cst (val_type, 0x110000)));
+  tree notvalid = fold_build1 (TRUTH_NOT_EXPR,
+			       integer_type_node,
+			       fold_build2 (TRUTH_OR_EXPR, integer_type_node,
+					    range1, range2));
+
+  /* Call to the runtime run-time error handler.  */
+  unsigned int lineno = NUMBER (LINE (INFO (p)));
+  const char *filename_str = FILENAME (LINE (INFO (p)));
+  tree filename = build_string_literal (strlen (filename_str) + 1,
+					    filename_str);
+  tree call = a68_build_libcall (A68_LIBCALL_INVALIDCHARERROR,
+				 void_type_node, 3,
+				 filename,
+				 build_int_cst (unsigned_type_node, lineno),
+				 fold_convert (a68_int_type, c));
+
+  /* Return the REPR of the given integer value, or raise run-time error.  */
+  return fold_build2 (COMPOUND_EXPR, a68_char_type,
+		      fold_build3 (COND_EXPR, integer_type_node,
+				   notvalid,
+				   call, integer_zero_node),
+		      fold_convert (a68_char_type, c));
+}
+
+/* the ABS of a CHAR is an INT containing an unique value for each permissable
+   char value.  */
+
+tree
+a68_char_abs (tree val)
+{
+  return fold_convert (a68_int_type, val);
+}
+
+/* Given two characters, build an expression that calculates whether A = B.  */
+
+tree
+a68_char_eq (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two characters, build an expression that calculates whether A /=
+   B.  */
+
+tree
+a68_char_ne (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two characters, build an expression that calculates
+   whether A < B.  */
+
+tree
+a68_char_lt (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, LT_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two characters, build an expression that calculates
+   whether A <= B.  */
+
+tree
+a68_char_le (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, LE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two characters, build an expression that calculates
+   whether A > B.  */
+
+tree
+a68_char_gt (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, GT_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two characters, build an expression that calculates
+   whether A >= B.  */
+
+tree
+a68_char_ge (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, GE_EXPR, boolean_type_node, a, b);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-clauses.cc
@@ -0,0 +1,1407 @@
+/* Lower clauses to GENERIC.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Given a serial_clause node P, return whether it performs dynamic stack
+   allocations.
+
+   This function allocates for the fact that the bottom-up parser generates
+   successively nested serial clauses like
+
+     SERIAL_CLAUSE
+       SERIAL_CLAUSE
+        ...
+
+   the outer of which corresponds to a single serial clause in the source code,
+   but it is the inner ones annotated by the dsa pass.  */
+
+static bool
+serial_clause_dsa (NODE_T *p)
+{
+  NODE_T *s = NEXT (SUB (p));
+
+  for (s = p; SUB (s) &&  IS (s, SERIAL_CLAUSE); s = SUB (s))
+    {
+      if (DYNAMIC_STACK_ALLOCS (s))
+	return true;
+    }
+
+  return false;
+}
+
+/* Lower one or more labels.
+
+     label : defining identifier, colon symbol;
+             label, defining identifier, colon symbol;
+
+   A label lowers into a LABEL_EXPR and the declaration of a LABEL_DECL in the
+   current block and bind.  Lists of labels get returned in nested compound
+   expressions.  */
+
+tree
+a68_lower_label (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree expr = NULL_TREE;
+
+  if (IS (SUB (p), LABEL))
+    expr = a68_lower_tree (SUB (p), ctx);
+
+  NODE_T *defining_identifier;
+
+  if (IS (SUB (p), DEFINING_IDENTIFIER))
+    defining_identifier = SUB (p);
+  else
+    {
+      gcc_assert (IS (NEXT (SUB (p)), DEFINING_IDENTIFIER));
+      defining_identifier = NEXT (SUB (p));
+    }
+
+  /* Create LABEL_DECL if necessary.  */
+  tree label_decl = TAX_TREE_DECL (TAX (defining_identifier));
+  if (label_decl == NULL_TREE)
+    {
+      label_decl = build_decl (a68_get_node_location (defining_identifier),
+			       LABEL_DECL,
+			       a68_get_mangled_identifier (NSYMBOL (defining_identifier)),
+			       void_type_node);
+      TAX_TREE_DECL (TAX (defining_identifier)) = label_decl;
+    }
+
+  a68_add_decl (label_decl);
+
+  /* Return the accummulated LABEL_EXPRs.  */
+  tree label_expr = build1 (LABEL_EXPR, void_type_node, label_decl);
+  if (expr)
+    return fold_build2_loc (a68_get_node_location (p),
+			    COMPOUND_EXPR,
+			    void_type_node,
+			    expr, label_expr);
+  else
+    return label_expr;
+}
+
+/* Lower a labeled unit.
+
+     labeled unit : label, unit.
+
+   Lower the label, then the unit.  Return them in a compound expression.  */
+
+tree
+a68_lower_labeled_unit (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree label_expr = a68_lower_tree (SUB (p), ctx);
+  tree unit_expr = a68_lower_tree (NEXT (SUB (p)), ctx);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  COMPOUND_EXPR,
+			  TREE_TYPE (unit_expr),
+			  label_expr, unit_expr);
+}
+
+/* Lower a completer.
+
+     exit_symbol
+
+   This handler replaces the last expression in stmt_list with a statement
+   assigning it to the clause result of the current serial clause, then jump to
+   the exit label of the current serial clause. Note that a completer is a
+   separator so stmt_list contains at least one expression at this point.  Note
+   that a completer can only appear inside a serial clause.
+
+   This function always returns NULL_TREE, so the traversing code shall always
+   be careful to travese on these nodes explicitly and ignore the returned
+   value.  */
+
+tree
+a68_lower_completer (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  a68_add_completer ();
+  return NULL_TREE;
+}
+
+/* Lower an initialiser series.
+
+   Parse tree:
+
+   initialiser series : serial clause, semi symbol, declaration list;
+                        initialiser series, declaration list;
+			initialiser series, semi symbol, unit;
+			initialiser series, semi symbol, labeled unit;
+			initialiser series, semi symbol, declaration list.
+
+   GENERIC:
+
+   Traverse subtree adding units and labels to STMT_LIST, and declarations to
+   BLOCK.
+
+   This function always returns NULL_TREE, so the traversing code shall always
+   be careful to travese on these nodes explicitly and ignore the returned
+   value.  */
+
+tree
+a68_lower_initialiser_series (NODE_T *p, LOW_CTX_T ctx)
+{
+  for (NODE_T *s = SUB (p); s != NO_NODE; FORWARD (s))
+    {
+      if (!IS (s, SEMI_SYMBOL))
+	a68_add_stmt (a68_lower_tree (s, ctx));
+    }
+  return NULL_TREE;
+}
+
+/* Lower a serial clause.
+
+     serial clause : labeled unit;
+                     unit;
+		     serial clause, semi symbol, unit;
+		     serial clause, exit symbol, labeled unit;
+		     serial clause, semi_symbol, declaration list;
+		     initialiser series, semi symbol, unit;
+		     initialiser series, semi symbol, labeled unit.
+
+   Ranges:
+
+     serial-clause
+     ------------- R1
+
+   See the function body to see the lowering actions.
+
+   This function always returns NULL_TREE, so the traversing code shall always
+   be careful to travese on these nodes explicitly and ignore the returned
+   value.  */
+
+tree
+a68_lower_serial_clause (NODE_T *p, LOW_CTX_T ctx)
+{
+  if (IS (SUB (p), SERIAL_CLAUSE))
+    {
+      /* Traverse down for side-effects.  */
+      (void) a68_lower_tree (SUB (p), ctx);
+
+      if (IS (NEXT (SUB (p)), EXIT_SYMBOL))
+	{
+	  /* Traverse the completer for side-effects.  This turns the last
+	     expression in the current statements list into an assignment.  */
+	  (void) a68_lower_tree (NEXT (SUB (p)), ctx);
+	  /* Now append the result of the labeled unit to the current
+	     statements list.  */
+	  a68_add_stmt (a68_lower_tree (NEXT (NEXT (SUB (p))), ctx));
+	}
+      else
+	{
+	  /* Append the result of either the unit or the declarations list in
+	     the current statements list.  */
+	  a68_add_stmt (a68_lower_tree (NEXT (NEXT (SUB (p))), ctx));
+	}
+    }
+  else if (IS (SUB (p), INITIALISER_SERIES))
+    {
+      /* Traverse down for side-effects.  */
+      (void) a68_lower_tree (SUB (p), ctx);
+
+      /* Append the result of either the unit or the declarations list in the
+	 current statements list.  */
+      a68_add_stmt (a68_lower_tree (NEXT (NEXT (SUB (p))), ctx));
+    }
+  else
+    {
+      /* Append the result of either the unit or labeled unit in the current
+	 statements list.  */
+      a68_add_stmt (a68_lower_tree (SUB (p), ctx));
+    }
+
+  return NULL_TREE;
+}
+
+/* Lower a loop clause.
+
+     loop clause : for part, from part, by part, to part, while part, alt do part;
+                   for part, from part, by part, while part, alt do part;
+		   for part, from part, while part, alt do part;
+		   for part, by part, to part, while part, alt do part;
+		   for part, by part, to part, while part, alt do part;
+		   for part, by part, while part, alt do part;
+		   for part, while part, alt do part;
+		   for part, from part, by part, to part, alt do part;
+		   for part, from part, by part, alt do part;
+		   for part, from part, alt do part;
+		   for part, by part, to part, alt do part;
+		   for part, by part, alt do part;
+		   for part, to part, alt do part,
+		   for part, alt do part;
+		   from part, by part, to part, while part, alt do part;
+		   from part, by part, while aprt, alt do part;
+		   from part, to part, while aprt, alt do part;
+		   from part, while part, alt do part;
+		   from part, by part, to part, alt do part;
+		   from part, by part, alt do part;
+		   from part, to part, alt do part;
+		   from part, alt do part;
+		   by part, to part, while part, alt do part;
+		   by part, while part, alt do part;
+		   by part, to part, alt do part;
+		   by part, alt do part;
+		   to part, while part, alt do part;
+		   to part, alt do part;
+		   while part, alt do part;
+		   do part.
+*/
+
+tree
+a68_lower_loop_clause (NODE_T *p ATTRIBUTE_UNUSED,
+		       LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  NODE_T *s = SUB (p);
+  bool while_part = false;
+  bool has_iterator = false;
+  tree iterator = NULL_TREE;
+  tree while_condition = NULL_TREE;
+  tree do_part = NULL_TREE;
+  tree from_part = NULL_TREE;
+  tree by_part = NULL_TREE;
+  tree to_part = NULL_TREE;
+  tree overflow = NULL_TREE;
+  NODE_T *iterator_defining_identifier = NO_NODE;
+
+  if (IS (s, FOR_PART))
+    {
+      /* Get the defining identifier.  */
+      iterator_defining_identifier = NEXT (SUB (s));
+      has_iterator = true;
+      FORWARD (s);
+    }
+
+  if (IS (s, FROM_PART))
+    {
+      /* Lower the unit.  */
+      from_part = a68_lower_tree (NEXT (SUB (s)), ctx);
+      has_iterator = true;
+      FORWARD (s);
+    }
+
+  if (IS (s, BY_PART))
+    {
+      /* Lower the unit.  */
+      by_part = a68_lower_tree (NEXT (SUB (s)), ctx);
+      has_iterator = true;
+      FORWARD (s);
+    }
+
+  if (IS (s, TO_PART))
+    {
+      /* Lower the unit.  */
+      to_part = a68_lower_tree (NEXT (SUB (s)), ctx);
+      has_iterator = true;
+      FORWARD (s);
+    }
+
+  if (has_iterator)
+    {
+      /* Introduce a range that spans until the end of the loop clause.   */
+      a68_push_range (M_VOID);
+
+      /* Compute some defaults for not specified loop parts.  Note that to_part
+	 defaults to max_int or min_int depending on the signedness of
+	 by_part.  */
+      if (from_part == NULL_TREE)
+	from_part = integer_one_node;
+      if (by_part == NULL_TREE)
+	by_part = integer_one_node;
+      if (to_part == NULL_TREE)
+	{
+	  to_part = fold_build3 (COND_EXPR,
+				 a68_bool_type,
+				 fold_build2 (LT_EXPR, a68_int_type, by_part,
+					      build_int_cst (a68_int_type, 0)),
+				 a68_int_minval (a68_int_type),
+				 a68_int_maxval (a68_int_type));
+	}
+
+      /* If the user has specified an explicit iterator in the form of a
+	 defining-identifier in a for-part, use it as the name in the iterator
+	 declaration and install the resulting declaration in the taxes table
+	 in order for applied identifiers in the rest of the loop to find it.
+	 Otherwise, the iterator is not directly accessible by the
+	 programmer.  */
+      const char *iterator_name = (iterator_defining_identifier == NO_NODE
+				   ? "iterator%"
+				   : NSYMBOL (iterator_defining_identifier));
+      iterator = a68_lower_tmpvar (iterator_name, a68_int_type, from_part);
+      if (iterator_defining_identifier != NO_NODE)
+	TAX_TREE_DECL (TAX (iterator_defining_identifier)) = iterator;
+
+      /* The from_part and to_part expressions shall be evaluated once and once
+	 only.  The expression for from_part is evaluated only once in the
+	 initialization expression for iterator% above, but we need to put
+	 to_part in a temporary since it is used in the loop body.  */
+      to_part = a68_lower_tmpvar ("to_part%", TREE_TYPE (to_part), to_part);
+
+      /* We need to detect overflow/underflow of the iterator.  */
+      overflow = a68_lower_tmpvar ("overflow%", boolean_type_node,
+				   boolean_false_node);
+    }
+
+  if (IS (s, WHILE_PART))
+    {
+      while_part = true;
+      /* Introduce a range that spans until the end of the loop clause.  */
+      a68_push_range (M_VOID);
+      /* Process the enquiry clause, which yields a BOOL.  */
+      a68_push_stmt_list (M_BOOL);
+      (void) a68_lower_tree (NEXT (SUB (s)), ctx);
+      while_condition = a68_pop_stmt_list ();
+      FORWARD (s);
+    }
+
+  /* DO part.  */
+  gcc_assert (IS (s, ALT_DO_PART) || IS (s, DO_PART));
+
+  /* Build the loop's body.  */
+  a68_push_range (NULL);
+  {
+    /* First lower the loop exit condition.  */
+    if (has_iterator || while_part)
+      {
+	tree exit_condition = NULL_TREE;
+	/* IF overflow OREL (by_part < 0 THEN iterator < to_part ELSE iterator > to_part) FI */
+	if (has_iterator)
+	  exit_condition = fold_build2 (TRUTH_ORIF_EXPR, boolean_type_node,
+					overflow,
+					fold_build3 (COND_EXPR,
+						     a68_bool_type,
+						     fold_build2 (LT_EXPR, a68_int_type, by_part,
+								  build_int_cst (a68_int_type, 0)),
+						     fold_build2 (LT_EXPR, a68_int_type,
+								  iterator, to_part),
+						     fold_build2 (GT_EXPR, a68_int_type,
+								  iterator, to_part)));
+	/* NOT while_condition */
+	if (while_part)
+	  {
+	    tree while_exit_condition = fold_build1 (TRUTH_NOT_EXPR,
+						     a68_bool_type,
+						     while_condition);
+	    if (has_iterator)
+	      exit_condition = fold_build2 (TRUTH_ORIF_EXPR, a68_bool_type,
+					    exit_condition, while_exit_condition);
+	    else
+	      exit_condition = while_exit_condition;
+	  }
+
+	if (exit_condition != NULL_TREE)
+	  a68_add_stmt (fold_build1 (EXIT_EXPR, void_type_node, exit_condition));
+      }
+
+    /* Serial clauses in DO .. OD do not yield any value.  */
+    bool dsa = serial_clause_dsa (NEXT (SUB (s)));
+    bool local = NON_LOCAL (NEXT (SUB (s))) == NO_TABLE;
+    a68_push_serial_clause_range (M_VOID, dsa && local);
+    (void) a68_lower_tree (NEXT (SUB (s)), ctx);
+    do_part = a68_pop_serial_clause_range ();
+    a68_add_stmt (do_part);
+
+    if (has_iterator)
+      {
+	/* Increment the iterator by BY_PART.  Detect overflow.
+	   Given a + b = sum, overflows = ((~((a) ^ (b)) & ((a) ^ (sum))) < 0)
+	   See OVERFLOW_SUM_SIGN in double-int.cc for an explanation
+	   of this formula.
+	*/
+	tree type = TREE_TYPE (iterator);
+	tree a = iterator;
+	tree b = save_expr (by_part);
+	tree sum = fold_build2 (PLUS_EXPR, type, a, b);
+	a68_add_stmt (fold_build2 (MODIFY_EXPR, boolean_type_node,
+				   overflow,
+				   fold_build2 (LT_EXPR, boolean_type_node,
+						fold_build2 (BIT_AND_EXPR, type,
+							     fold_build1 (BIT_NOT_EXPR, type,
+									  fold_build2 (BIT_XOR_EXPR, type,
+										       a, b)),
+							     fold_build2 (BIT_XOR_EXPR, type,
+									  a, sum)),
+						build_int_cst (a68_int_type, 0))));
+	a68_add_stmt (fold_build2 (MODIFY_EXPR, type, iterator, sum));
+      }
+  }
+  tree loop_body = a68_pop_range ();
+
+  /* Finally build the LOOP_EXPR and exit the introduced ranges.  */
+  tree loop_clause = fold_build1_loc (a68_get_node_location (p),
+				      LOOP_EXPR, a68_void_type, loop_body);
+  if (while_part)
+    {
+      a68_add_stmt (loop_clause);
+      loop_clause = a68_pop_range ();
+    }
+  if (has_iterator)
+    {
+      a68_add_stmt (loop_clause);
+      loop_clause = a68_pop_range ();
+    }
+
+  return loop_clause;
+}
+
+/* Lower a conformity clause.
+
+     conformity clause : case part, conformity in part, out part, esac symbol;
+                         case part, conformity in part, esac symbol;
+			 case part, conformity in part, conformity ouse part;
+                         open part, conformity choice, choice, close symbol;
+                         open part, conformity choice, close symbol;
+			 open part, conformity choice, brief conformity ouse part.
+
+     conformity choice : then bar symbol, specified unit list;
+                         then bar symbol, specified unit.
+
+     specified unit list : specified unit list, comma symbol, specified unit;
+                           specified unit list, specified unit.
+
+     specified unit : specifier, colon symbol, unit.
+
+     specifier : open symbol, declarer, identifier, close symbol;
+                 open symbol, declarer, close symbol;
+		 open symbol, void symbol, close symbol.
+*/
+
+static void
+lower_unite_case_unit (NODE_T *p,
+		       tree enquiry, MOID_T *enquiry_mode,
+		       tree result, tree exit_label, LOW_CTX_T ctx)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, SPECIFIER))
+	{
+	  MOID_T *spec_moid = MOID (NEXT (SUB (p)));
+	  NODE_T *spec_identifier = NEXT (NEXT (SUB (p)));
+	  NODE_T *spec_unit = NEXT (NEXT (p));
+	  const char *specifier_identifier_name = NULL;
+	  if (IS (spec_identifier, IDENTIFIER))
+	    specifier_identifier_name = NSYMBOL (spec_identifier);
+
+	  tree overhead = a68_union_overhead (enquiry);
+	  tree spec_value = NULL_TREE;
+	  tree entry_selected = NULL_TREE;
+	  if (IS_UNION (spec_moid))
+	    {
+	      /* The spec_moid is an united mode, which must be unitable to the
+		 enquiry_mode.  */
+	      gcc_assert (a68_is_unitable (spec_moid, enquiry_mode,
+					   SAFE_DEFLEXING));
+
+	      /* Build the entry_selected expression.
+
+		 For each mode in spec_moid, determine the corresponding index
+		 in enquiry_mode and add a check for it to the expression.  */
+	      for (PACK_T *pack = PACK (spec_moid); pack != NO_PACK; FORWARD (pack))
+		{
+		  int index = a68_united_mode_index (enquiry_mode, MOID (pack));
+		  tree expr = fold_build2 (EQ_EXPR,
+					   boolean_type_node,
+					   overhead,
+					   build_int_cst (TREE_TYPE (overhead), index));
+		  if (entry_selected == NULL_TREE)
+		    entry_selected = expr;
+		  else
+		    entry_selected = fold_build2 (TRUTH_OR_EXPR,
+						  boolean_type_node,
+						  entry_selected,
+						  expr);
+		}
+
+	      /* The spec_value is an union of mode spec_moid, with the
+		 overhead translated from enquiry_mode.  */
+	      tree spec_overhead
+		= a68_union_translate_overhead (enquiry_mode, overhead, spec_moid);
+	      a68_push_range (spec_moid);
+	      spec_value = a68_lower_tmpvar ("spec_value%",
+					     CTYPE (spec_moid),
+					     a68_get_skip_tree (spec_moid));
+	      a68_add_stmt (a68_union_set_overhead (spec_value, spec_overhead));
+	      tree from_cunion = a68_union_cunion (enquiry);
+	      tree to_cunion = a68_union_cunion (spec_value);
+	      a68_add_stmt (a68_lower_memcpy (fold_build1 (ADDR_EXPR,
+							   build_pointer_type (TREE_TYPE (to_cunion)),
+							   to_cunion),
+					      fold_build1 (ADDR_EXPR,
+							   build_pointer_type (TREE_TYPE (from_cunion)),
+							   from_cunion),
+					      size_in_bytes (TREE_TYPE (to_cunion))));
+	      a68_add_stmt (spec_value);
+	      spec_value = a68_pop_range ();
+	    }
+	  else
+	    {
+	      int index = a68_united_mode_index (enquiry_mode, spec_moid);
+	      spec_value = a68_union_alternative (enquiry, index);
+	      entry_selected = fold_build2 (EQ_EXPR,
+					    TREE_TYPE (overhead),
+					    overhead,
+					    build_int_cst (TREE_TYPE (overhead), index));
+	    }
+
+	  a68_push_range (M_VOID);
+	  {
+	    /* If the enquiry value is ascribed to an identifier in the case
+	       entry then create a suitable declaration and turn the identifier
+	       into a defining identifier.  */
+	    if (specifier_identifier_name)
+	      {
+		tree united_value = a68_lower_tmpvar (specifier_identifier_name,
+						      CTYPE (spec_moid), spec_value);
+		TAX_TREE_DECL (TAX (spec_identifier)) = united_value;
+	      }
+
+	    /* Set result% to the lowering of the unit and jump to the end of
+	       the enquiry clause.  */
+	    a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (result),
+				       result, a68_lower_tree (spec_unit, ctx)));
+	    a68_add_stmt (fold_build1 (GOTO_EXPR,
+				       void_type_node,
+				       exit_label));
+	    a68_add_stmt (a68_get_skip_tree (M_VOID));
+	  }
+	  tree process_entry = a68_pop_range ();
+
+	  /* IF index = overhead THEN process entry FI */
+	  a68_add_stmt (fold_build3 (COND_EXPR,
+				     a68_void_type,
+				     entry_selected,
+				     process_entry,
+				     a68_get_skip_tree (M_VOID)));
+
+	  FORWARD (p); /* Skip specifier.  */
+	  FORWARD (p); /* Skip unit.  */
+	  /* The unit is skipped in the for loop post-action.  */
+	}
+      else
+	lower_unite_case_unit (SUB (p),
+			       enquiry, enquiry_mode,
+			       result, exit_label, ctx);
+    }
+}
+
+tree
+a68_lower_conformity_clause (NODE_T *p, LOW_CTX_T ctx)
+{
+  MOID_T *conformity_clause_mode = MOID (p);
+
+  /* CASE or OUSE.  */
+  NODE_T *s = SUB (p);
+  NODE_T *enquiry_node = NEXT (SUB (s));
+  MOID_T *enquiry_mode = MOID (SUB (s));
+
+  /* Push a binding environment for the enquiry clause.  */
+  a68_push_range (conformity_clause_mode);
+
+  /* Process the enquiry clause and put the resulting value in enquiry%.  */
+  a68_push_stmt_list (enquiry_mode);
+  (void) a68_lower_tree (enquiry_node, ctx);
+  tree enquiry = a68_lower_tmpvar ("enquiry%",
+				   CTYPE (enquiry_mode),
+				   a68_pop_stmt_list ());
+
+  /* Create a decl for result%.  */
+  tree result = a68_lower_tmpvar ("result%",
+				  CTYPE (conformity_clause_mode),
+				  a68_get_skip_tree (conformity_clause_mode));
+
+  /* Create an exit label.  */
+  tree exit_label = build_decl (UNKNOWN_LOCATION,
+				LABEL_DECL,
+				get_identifier ("exit_label%"),
+				void_type_node);
+  DECL_CONTEXT (exit_label) = a68_range_context ();
+  a68_add_decl (exit_label);
+  a68_add_decl_expr (fold_build1 (DECL_EXPR, TREE_TYPE (exit_label), exit_label));
+
+  /* IN.  */
+  FORWARD (s);
+  lower_unite_case_unit (NEXT (SUB (s)),
+			 enquiry, enquiry_mode,
+			 result, exit_label, ctx);
+
+  /* OUT.  */
+  FORWARD (s);
+  switch (ATTRIBUTE (s))
+    {
+    case CHOICE:
+    case OUT_PART:
+      {
+	bool dsa = serial_clause_dsa (NEXT (SUB (s)));
+	bool local = NON_LOCAL (NEXT (SUB (s))) == NO_TABLE;
+	a68_push_serial_clause_range (conformity_clause_mode, dsa && local);
+
+	(void) a68_lower_tree (NEXT (SUB (s)), ctx);
+	a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (result),
+				   result, a68_pop_serial_clause_range ()));
+	a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label));
+	break;
+      }
+    case CLOSE_SYMBOL:
+    case ESAC_SYMBOL:
+      a68_add_stmt (fold_build2 (MODIFY_EXPR,
+				 TREE_TYPE (result),
+				 result,
+				 a68_get_skip_tree (conformity_clause_mode)));
+      a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label));
+      break;
+    default:
+      /* Recurse.
+
+	 Note that the parser guarantees that the embedded CASE clause is a
+	 conformity clause, and that its mode is the same than the containing
+	 clause, but it doesn't annotate the mode in the tree node so we have
+	 to do it here.  */
+      MOID (s) = conformity_clause_mode;
+      a68_add_stmt (fold_build2 (MODIFY_EXPR,
+				 TREE_TYPE (result),
+				 result,
+				 a68_lower_conformity_clause (s, ctx)));
+      a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label));
+      break;
+    }
+
+  /* ESAC */
+  a68_add_stmt (build1 (LABEL_EXPR, void_type_node, exit_label));
+  a68_add_stmt (result);
+  return a68_pop_range ();
+}
+
+/* Lower a case clause.
+
+     case clause : open part, case choice clause, choice, close symbol;
+                   open part, case choice clause, close symbol;
+		   open part, case shoice clause, brief ouse part;
+		   case part, case in part, out part, esac symbol;
+		   case part, case in part, esac symbol;
+		   case part, case in part, case ouse part;
+*/
+
+static void
+lower_int_case_unit (NODE_T *p,
+		     tree enquiry, MOID_T *enquiry_mode,
+		     tree result, tree exit_label, int *count,
+		     LOW_CTX_T ctx)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, UNIT))
+	{
+	  a68_push_range (M_VOID);
+	  {
+	    /* Set result% to the lowering of the unit and jump to the end of
+	       the enquiry clause.  */
+	    a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (result),
+				       result, a68_lower_tree (p, ctx)));
+	    a68_add_stmt (fold_build1 (GOTO_EXPR,
+				       void_type_node,
+				       exit_label));
+	    a68_add_stmt (a68_get_skip_tree (M_VOID));
+	  }
+	  tree process_entry = a68_pop_range ();
+
+	  /* IF count = enquiry THEN process entry FI */
+	  a68_add_stmt (fold_build3 (COND_EXPR,
+				     a68_void_type,
+				     fold_build2 (EQ_EXPR,
+						  TREE_TYPE (enquiry),
+						  enquiry,
+						  build_int_cst (TREE_TYPE (enquiry), *count)),
+				     process_entry,
+				     a68_get_skip_tree (M_VOID)));
+	  *count += 1;
+	}
+      else
+	lower_int_case_unit (SUB (p),
+			     enquiry, enquiry_mode,
+			     result, exit_label, count, ctx);
+    }
+}
+
+tree
+a68_lower_case_clause (NODE_T *p ATTRIBUTE_UNUSED,
+		       LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  MOID_T *case_clause_mode = MOID (p);
+
+  /* CASE or OUSE  */
+  NODE_T *s = SUB (p);
+  NODE_T *enquiry_node = NEXT (SUB (s));
+  MOID_T *enquiry_mode = M_INT;
+
+  /* Push a bingding environment fo the case clause.  */
+  a68_push_range (case_clause_mode);
+
+  /* Process the enquiry clause and put the result value in enquiry%.  */
+  a68_push_stmt_list (enquiry_mode);
+  (void) a68_lower_tree (enquiry_node, ctx);
+  tree enquiry = a68_lower_tmpvar ("enquiry%",
+				   CTYPE (enquiry_mode),
+				   a68_pop_stmt_list ());
+  /* Create a decl for result%.  */
+  tree result = a68_lower_tmpvar ("result%",
+				  CTYPE (case_clause_mode),
+				  a68_get_skip_tree (case_clause_mode));
+
+  /* Create an exit label.  */
+  tree exit_label = build_decl (UNKNOWN_LOCATION,
+				LABEL_DECL,
+				get_identifier ("exit_label%"),
+				void_type_node);
+  DECL_CONTEXT (exit_label) = a68_range_context ();
+  a68_add_decl (exit_label);
+  a68_add_decl_expr (fold_build1 (DECL_EXPR, TREE_TYPE (exit_label), exit_label));
+
+  /* IN.  */
+  FORWARD (s);
+  int count = 1;
+  lower_int_case_unit (NEXT (SUB (s)),
+		       enquiry, enquiry_mode,
+		       result, exit_label, &count, ctx);
+
+  /* OUT.  */
+  FORWARD (s);
+  switch (ATTRIBUTE (s))
+    {
+    case CHOICE:
+    case OUT_PART:
+      {
+	bool dsa = serial_clause_dsa (NEXT (SUB (s)));
+	bool local = NON_LOCAL (NEXT (SUB (s))) == NO_TABLE;
+	a68_push_serial_clause_range (case_clause_mode, dsa && local);
+
+	(void) a68_lower_tree (NEXT (SUB (s)), ctx);
+	a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (result),
+				   result, a68_pop_serial_clause_range ()));
+	a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label));
+	break;
+      }
+    case CLOSE_SYMBOL:
+    case ESAC_SYMBOL:
+      a68_add_stmt (fold_build2 (MODIFY_EXPR,
+				 TREE_TYPE (result),
+				 result,
+				 a68_get_skip_tree (case_clause_mode)));
+      a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label));
+      break;
+    default:
+      /* Recurse.
+
+	 Note that the parser guarantees that the embedded CASE clause has the
+	 same mode than the containing clause, but it doesn't annotate the OUSE
+	 node with its mode so we have to do it here.  */
+      MOID (s) = case_clause_mode;
+      a68_add_stmt (fold_build2 (MODIFY_EXPR,
+				 TREE_TYPE (result),
+				 result,
+				 a68_lower_case_clause (s, ctx)));
+      a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label));
+      break;
+    }
+
+  /* ESAC */
+  a68_add_stmt (build1 (LABEL_EXPR, void_type_node, exit_label));
+  a68_add_stmt (result);
+  return a68_pop_range ();
+}
+
+/* Lower an enquiry clause.
+
+     enquiry clause : unit;
+                      enquiry clause, semi symbol, unit;
+                      enquiry clause, comma symbol, unit;
+		      initialiser series, semi symbol, unit.
+
+   The units and declarations in the enquiry clause get lowered into
+   expressions and declaration nodes which are added to the current serial
+   clause.
+
+   This function always returns NULL_TREE, so the traversing code shall always
+   be careful to travese on these nodes explicitly and ignore the returned
+   value.  */
+
+tree
+a68_lower_enquiry_clause (NODE_T *p, LOW_CTX_T ctx)
+{
+  if (IS (SUB (p), UNIT))
+    {
+      a68_add_stmt (a68_lower_tree (SUB (p), ctx));
+    }
+  else if (IS (SUB (p), ENQUIRY_CLAUSE))
+    {
+      (void) a68_lower_tree (SUB (p), ctx);
+      gcc_assert (IS (NEXT (NEXT (SUB (p))), UNIT));
+      a68_add_stmt (a68_lower_tree (NEXT (NEXT (SUB (p))), ctx));
+    }
+  else
+    {
+      gcc_assert (IS (SUB (p), INITIALISER_SERIES));
+      gcc_assert (IS (NEXT (NEXT (SUB (p))), UNIT));
+      (void) a68_lower_tree (SUB (p), ctx);
+      a68_add_stmt (a68_lower_tree (NEXT (NEXT (SUB (p))), ctx));
+    }
+
+  return NULL_TREE;
+}
+
+/* Lower a conditional clause.
+
+     conditional clause : open part, choice, choice, close symbol;
+                          open part, choice, close symbol;
+			  open part, choice, brief elif part;
+			  if part, then part, else part, fi symbol;
+			  if part, then part, elif part;
+			  if part, then part, fi symbol.
+
+     if part : if symbol, enquiry clause;
+               if symbol, initialiser series.
+
+     then part : then symbol, serial clause;
+                 then symbol, initialiser series.
+
+     elif part : elif if part, then part, else part, fi symbol;
+                 elif if part, then part, fi symbol;
+		 elif if part, then part, elif part.
+
+     else part : else symbol, serial clause;
+                 else symbol, initialiser series.
+
+     elif if part : elif symbol, enquiry clause.
+
+     open part : open symbol, enquiry clause.
+
+     choice : then bar symbol, serial clause;
+              then bar symbol initialiser series.
+
+     brief elif part : else open part, choice, choice, close symbol;
+                       else open part, choice, close symbol;
+		       else open part, choice, bief elif part.
+
+     else open part : else bar symbol, enquiry clause;
+                      else bar symbol, initialiser series.
+
+   Ranges:
+
+     IF enquiry-clause THEN expr ELSE expr FI
+                            --- R2    ---- R3
+     ---------------------------------------- R1
+
+   The conditional clause lowers into:
+
+     BIND_EXPR
+       BIND_EXPR_VARS -> delcls in enquiry clause.
+       BIND_EXPR_BODY
+         STMT_LIST
+           enquiry% = ...;
+           COND_EXPR (enquiry%, then_expr, else_expr)  */
+
+tree
+a68_lower_conditional_clause (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree then_expr = NULL_TREE;
+  tree else_expr = NULL_TREE;
+
+  MOID_T *conditional_clause_mode = MOID (p);
+  MOID_T *effective_rows_mode = NO_MOID;
+  bool is_rows = false;
+
+  /* Push a binding environment for the conditional.  */
+  a68_push_range (is_rows ? effective_rows_mode : conditional_clause_mode);
+
+  /* Create a decl for %enquiry and add it to the bind's declaration chain.  */
+  tree enquiry_decl = build_decl (UNKNOWN_LOCATION,
+				  VAR_DECL,
+				  NULL, /* Set below.  */
+				  a68_bool_type);
+  char *enquiry_name = xasprintf ("enquiry%d%%", DECL_UID(enquiry_decl));
+  DECL_NAME (enquiry_decl) = get_identifier (enquiry_name);
+  free (enquiry_name);
+  DECL_INITIAL (enquiry_decl) = a68_get_skip_tree (M_BOOL);
+  a68_add_decl (enquiry_decl);
+
+  /* Add a DECL_EXPR for enquiry_decl%  */
+  a68_add_stmt (fold_build1 (DECL_EXPR, a68_bool_type, enquiry_decl));
+
+  /* IF or ELIF part.  */
+  NODE_T *s = SUB (p);
+
+  /* Process the enquiry clause.  */
+  (void) a68_lower_tree (NEXT (SUB (s)), ctx);
+
+  /* Assignation enquiry% = .. expr ..
+     Note that since no completers are allowed in enquiry clauses,
+     the last statement in the statement list has to be the unit
+     yielding the boolean value.  */
+  tree_stmt_iterator si = tsi_last (a68_range_stmt_list ());
+  gcc_assert (TREE_TYPE (tsi_stmt (si)) != void_type_node);
+  a68_add_stmt (fold_build2 (MODIFY_EXPR, a68_bool_type, enquiry_decl, tsi_stmt (si)));
+  tsi_delink (&si);
+
+  /* THEN part.  */
+  FORWARD (s);
+  bool dsa = serial_clause_dsa (NEXT (SUB (s)));
+  bool local = NON_LOCAL (NEXT (SUB (s))) == NO_TABLE;
+  a68_push_serial_clause_range (is_rows ? effective_rows_mode : conditional_clause_mode,
+				dsa && local);
+  (void) a68_lower_tree (NEXT (SUB (s)), ctx);
+  then_expr = a68_pop_serial_clause_range ();
+
+  /* ELSE part  */
+  FORWARD (s);
+  switch (ATTRIBUTE (s))
+    {
+    case CHOICE:
+    case ELSE_PART:
+      {
+	bool dsa = serial_clause_dsa (NEXT (SUB (s)));
+	bool local = NON_LOCAL (NEXT (SUB (s))) == NO_TABLE;
+	a68_push_serial_clause_range (is_rows ? effective_rows_mode : conditional_clause_mode,
+				      dsa && local);
+	(void) a68_lower_tree (NEXT (SUB (s)), ctx);
+	else_expr = a68_pop_serial_clause_range ();
+	break;
+      }
+    case CLOSE_SYMBOL:
+    case FI_SYMBOL:
+      {
+	else_expr = a68_get_skip_tree (is_rows ? effective_rows_mode : conditional_clause_mode);
+	break;
+      }
+    default:
+      {
+	/* ELIF part.  Recurse.  */
+	MOID (s) = conditional_clause_mode;
+	else_expr = a68_lower_conditional_clause (s, ctx);
+      }
+    }
+
+  /* Build the conditional clause's COND_EXPR.  */
+  a68_add_stmt (fold_build3_loc (a68_get_node_location (p),
+				 COND_EXPR,
+				 CTYPE (is_rows ? effective_rows_mode : conditional_clause_mode),
+				 enquiry_decl,
+				 then_expr, else_expr));
+
+  return a68_pop_range ();
+}
+
+/* Lower a comma separated list of zero, two, or more units
+
+     unit list : unit list, comma symbol, unit;
+                 unit list, unit.
+
+   The list of units lowers into appending the units into the current
+   statements list.
+
+   This function always returns NULL_TREE, so the traversing code shall always
+   be careful to traverse on these nodes explicitly and ignore the returned
+   value.  */
+
+tree
+a68_lower_unit_list (NODE_T *p, LOW_CTX_T ctx)
+{
+  if (IS (SUB (p), UNIT_LIST))
+    (void) a68_lower_tree (SUB (p), ctx);
+
+  for (NODE_T *s = SUB (p); s != NO_NODE; FORWARD (s))
+    {
+      if (IS (s, UNIT))
+	a68_add_stmt (a68_lower_tree (s, ctx));
+    }
+
+  return NULL_TREE;
+}
+
+/* Lower a collateral clause.
+
+     collateral clause : open symbol, unit list, close symbol;
+                         open symbol, close symbol;
+                         begin symbol, unit list, end symbol;
+			 begin symbol, end symbol.
+
+   An empty collateral clause lowers into EMPTY.  */
+
+tree
+a68_lower_collateral_clause (NODE_T *p ATTRIBUTE_UNUSED,
+			     LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  bool clause_is_empty = (ATTRIBUTE (NEXT (SUB (p))) != UNIT_LIST);
+  MOID_T *mode = MOID (p);
+
+  /* Lower the constituent units into a statements list.  */
+  a68_push_stmt_list (mode);
+  if (!clause_is_empty)
+    (void) a68_lower_tree (NEXT (SUB (p)), ctx);
+  tree units = a68_pop_stmt_list ();
+
+  /* The collateral clause lowers to different constructions depending on its
+     nature.  */
+  if (mode == M_VOID)
+    {
+      /* A VOID-collateral-clause lowers into a STMT_LIST containing all
+	 the units.  Since there cannot be declarations in a collateral
+	 clause, there is no need to introduce a new binding scope.  Note
+	 that for now we are not really elaborating collaterally, but
+	 sequentially.  */
+      return units;
+    }
+  else if (IS_FLEXETY_ROW (mode) || mode == M_STRING)
+    {
+      if (mode == M_STRING)
+	mode = M_FLEX_ROW_CHAR;
+
+      /* This is a row display.  It lowers to a multiple.  */
+      tree row_type = CTYPE (mode);
+      size_t dim = DIM (DEFLEX (mode));
+
+      if (clause_is_empty)
+	{
+	  /* The clause is empty.  This lowers into a multiple with DIM
+	     dimension, each dimension having bounds of 1:0, and no
+	     elements.  */
+	  tree element_pointer_type = a68_row_elements_pointer_type (row_type);
+	  tree multiple_elements = build_int_cst (element_pointer_type, 0);
+	  tree multiple_elements_size = size_zero_node;
+
+	  tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * dim);
+	  tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * dim);
+	  tree ssize_one_node = fold_convert (ssizetype, size_one_node);
+	  tree ssize_zero_node = fold_convert (ssizetype, size_zero_node);
+	  for (size_t d = 0; d < dim; ++d)
+	    {
+	      lower_bounds[d] = ssize_one_node;
+	      upper_bounds[d] = ssize_zero_node;
+	    }
+
+	  tree row = a68_row_value (row_type, dim,
+				    multiple_elements,
+				    multiple_elements_size,
+				    lower_bounds, upper_bounds);
+	  TREE_CONSTANT (row) = 1;
+	  free (lower_bounds);
+	  free (upper_bounds);
+	  return row;
+	}
+
+      if (dim == 1)
+	{
+	  /* Create a constructor with the multiple's elements.  */
+	  vec <constructor_elt, va_gc> *ve = NULL;
+	  int num_units = 0;
+	  for (tree_stmt_iterator si = tsi_start (units); !tsi_end_p (si); tsi_next (&si))
+	    {
+	      tree unit = tsi_stmt (si);
+	      if (A68_TYPE_HAS_ROWS_P (TREE_TYPE (unit)))
+		unit = a68_low_dup (unit);
+	      CONSTRUCTOR_APPEND_ELT (ve, size_int (num_units), unit);
+	      num_units += 1;
+	    }
+
+	  tree element_pointer_type = a68_row_elements_pointer_type (row_type);
+	  tree array_constructor_type = build_array_type (TREE_TYPE (element_pointer_type),
+							  build_index_type (size_int (num_units - 1)));
+	  tree array_constructor = build_constructor (array_constructor_type, ve);
+	  tree multiple_elements = fold_build1 (ADDR_EXPR,
+						element_pointer_type,
+						array_constructor);
+	  tree elements_type = TREE_TYPE (element_pointer_type);
+	  tree multiple_elements_size = fold_build2 (MULT_EXPR, sizetype,
+						     size_int (num_units),
+						     size_in_bytes (elements_type));
+	  tree lower_bound = fold_convert (ssizetype, size_one_node);
+	  tree upper_bound = ssize_int (num_units);
+	  tree row = a68_row_value (row_type, dim,
+				    multiple_elements,
+				    multiple_elements_size,
+				    &lower_bound, &upper_bound);
+	  return row;
+	}
+      else
+	{
+	  gcc_assert (dim > 1);
+
+	  /* The units in the collateral clause are multiples, whose elements
+	     are to be copied consecutively in a new multiple.  The descriptor
+	     of this multiple is constructed as follows:
+
+	     The first dimension is:
+
+	     - The lower bound is 1.
+	     - The upper bound is the number of sub-multiples processed
+	       here.
+             - The stride is the number of elements in each sub-multiple
+	       multiplied by the element size.
+
+	     Subsequent dimensions are taken from the first inner multiple.
+	     All descriptors of the inner multiples shall be equal.  This is
+	     checked at run-time, and in case of discrepancy a run-time error
+	     is emitted.
+
+             Let's see an example.  Suppose in the stmt-list we have:
+
+               (1, 2, 3)
+                 {triplets: {lb: 1 ub: 3 stride: 1S} elements: {1, 2, 3}}
+               (4, 5, 6)
+                 {triplets: {lb: 1 ub: 3 stride: 1S} elements: {4, 5, 6}}
+
+             The resulting multiple would be:
+
+               ((1, 2, 3), (4, 5, 6))
+                 {triplets: {{lb: 1 ub: 2 stride: 3S}, {lb: 1 ub: 3 stride: 1S}}
+                  elements: {1, 2, 3, 4, 5, 6}}  */
+
+	  tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * dim);
+	  tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * dim);
+	  size_t num_units = 0;
+
+	  for (tree_stmt_iterator si = tsi_start (units); !tsi_end_p (si); tsi_next (&si))
+	    num_units++;
+
+	  a68_push_range (mode);
+
+	  /* Process each sub-multiple.  The first sub-multiple establishes the
+	     bounds that all subsequent sub-multiples shall match.  */
+	  tree multiple_elements = NULL_TREE;
+	  tree multiple_elements_size = NULL_TREE;
+	  tree sub_multiple = NULL_TREE;
+	  //	  tree sub_multiple_lb = NULL_TREE;
+	  //	  tree sub_multiple_ub = NULL_TREE;
+	  //	  tree sub_multiple_stride = NULL_TREE;
+	  tree index = a68_lower_tmpvar ("index%", sizetype, size_zero_node);
+	  for (tree_stmt_iterator si = tsi_start (units); !tsi_end_p (si); tsi_next (&si))
+	    {
+	      if (sub_multiple == NULL)
+		sub_multiple = a68_lower_tmpvar ("sub_multiple%",
+						 TREE_TYPE (tsi_stmt (si)),
+						 tsi_stmt (si));
+	      else
+		a68_add_stmt (fold_build2 (MODIFY_EXPR,
+					   TREE_TYPE (tsi_stmt (si)),
+					   sub_multiple,
+					   tsi_stmt (si)));
+
+	      if (si == tsi_start (units))
+		{
+#if 0
+		  tree ssize_zero_node = fold_convert (ssizetype, size_zero_node);
+		  /* The first sub-multiple establishes the bounds that all
+		     subsequent sub-multiples shall match.  */
+		  sub_multiple_lb = a68_lower_tmpvar ("sub_multiple_lb%",
+						      ssizetype,
+						      a68_multiple_lower_bound (sub_multiple,
+										ssize_zero_node));
+		  sub_multiple_ub = a68_lower_tmpvar ("sub_multiple_ub%",
+						      ssizetype,
+						      a68_multiple_upper_bound (sub_multiple,
+										ssize_zero_node));
+		  sub_multiple_stride = a68_lower_tmpvar ("sub_multiple_stride%",
+							  sizetype,
+							  a68_multiple_stride (sub_multiple,
+									       size_zero_node));
+#endif
+		  /* Now we have enough information to calculate the size of
+		     the elements of the new multiple and allocate
+		     multiple_elements.  */
+		  tree sub_multiple_elements = a68_multiple_elements (sub_multiple);
+		  tree elements_pointer_type = TREE_TYPE (sub_multiple_elements);
+		  tree elements_type = TREE_TYPE (elements_pointer_type);
+		  multiple_elements_size = fold_build2 (MULT_EXPR, sizetype,
+							     size_int (num_units),
+							     size_in_bytes (elements_type));
+		  multiple_elements_size = fold_build2 (MULT_EXPR, sizetype,
+							multiple_elements_size,
+							a68_multiple_num_elems (sub_multiple));
+		  multiple_elements = a68_lower_tmpvar ("multiple_elements%",
+							elements_pointer_type,
+							a68_lower_alloca (elements_type,
+									  multiple_elements_size));
+
+		  /* We can also now calculate the bounds of the new multiple.
+		     The top-level triplet has lower bound 1, upper bound is
+		     num_units, and stride is the number of elements in each
+		     sub-multiple multiplied by the element size.  Bounds for
+		     the subsequent DIM-1 dimensions are copied from the
+		     sub-multiple's descriptor.  */
+		  lower_bounds[0] = fold_convert (ssizetype, size_one_node);
+		  upper_bounds[0] = ssize_int (num_units);
+		  for (size_t d = 1; d < dim; ++d)
+		    {
+		      lower_bounds[d] = a68_multiple_lower_bound (sub_multiple,
+								  ssize_int (d - 1));
+		      upper_bounds[d] = a68_multiple_upper_bound (sub_multiple,
+								  ssize_int (d - 1));
+		    }
+		}
+	      else
+		{
+		  /* Check bounds of this sub-multiple.  Note that this is
+		     always done at run-time, since the interpretation of a row
+		     display depens on the target type, whether it is a row row
+		     or a row of rows, for example.  */
+		  // XXX use sub_multiple_lb, sub_multiple_ub and sub_multiple_stride
+		}
+
+	      /* Copy the elements of a copy of the sub-multiple in the
+		 elements of the multiple.  */
+	      tree sub_multiple_elements = a68_multiple_elements (sub_multiple);
+	      // XXX should we make a copy of the sub_multiple_elements here?
+	      // We DO need to iterate slicing, because of strides: if
+	      // the sub_multiple is a trimmer.
+	      sub_multiple_elements = sub_multiple_elements;
+	      tree sub_multiple_elements_type = TREE_TYPE (sub_multiple_elements);
+	      tree sub_multiple_num_elems = a68_multiple_num_elems (sub_multiple);
+	      tree sub_multiple_element_type = TREE_TYPE (sub_multiple_elements_type);
+	      tree sub_multiple_elements_size = fold_build2 (MULT_EXPR, sizetype,
+							     sub_multiple_num_elems,
+							     size_in_bytes (sub_multiple_element_type));
+
+	      /* memcpy (multiple_elements[index], sub_multiple_elements)  */
+	      a68_add_stmt (a68_lower_memcpy (fold_build2 (POINTER_PLUS_EXPR,
+							   sub_multiple_elements_type,
+							   multiple_elements,
+							   index),
+					      sub_multiple_elements,
+					      sub_multiple_elements_size));
+	      /* index += sub_multiple_elements_size */
+	      a68_add_stmt (fold_build2 (MODIFY_EXPR, sizetype,
+					 index,
+					 fold_build2 (PLUS_EXPR, sizetype,
+						      index, sub_multiple_elements_size)));
+	    }
+
+	  tree multiple = a68_lower_tmpvar ("multiple%",
+					    row_type,
+					    a68_row_value (row_type, dim,
+							   multiple_elements,
+							   multiple_elements_size,
+							   lower_bounds, upper_bounds));
+	  free (lower_bounds);
+	  free (upper_bounds);
+
+	  /* Yield the multiple.  */
+	  a68_add_stmt (multiple);
+	  return a68_pop_range ();
+	}
+    }
+  else if (IS_STRUCT (mode))
+    {
+      /* This is a struct display.  There are as many units in the clause as
+	 fields in the struct type.  Build a constructor with the values for
+	 the fields.  */
+      vec <constructor_elt, va_gc> *ve = NULL;
+      tree_stmt_iterator si = tsi_start (units);
+      for (tree f = TYPE_FIELDS (CTYPE (mode)); f; f = DECL_CHAIN (f))
+	{
+	  tree v = tsi_stmt (si);
+	  gcc_assert (v != NULL_TREE);
+	  v = a68_consolidate_ref (a68_type_moid (TREE_TYPE (f)) ,v);
+	  CONSTRUCTOR_APPEND_ELT (ve, f, v);
+	  tsi_next (&si);
+	}
+      tree ctor = build_constructor (CTYPE (mode), ve);
+      return ctor;
+    }
+  else
+    gcc_unreachable ();
+}
+
+/* Lower a parallel clause.
+
+     parallel clause : par symbol, collateral clause.
+*/
+
+tree
+a68_lower_parallel_clause (NODE_T *p ATTRIBUTE_UNUSED,
+			   LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  /* XXX For now treat like a VOID collateral clause.  */
+  return a68_lower_tree (NEXT (SUB (p)), ctx);
+}
+
+/* Lower a closed clause.
+
+     closed clause : open symbol, serial clause, close symbol;
+                     open symbol, initialiser series, close symbol;
+		     begin symbol, serial clause, end symbol;
+		     begin symbol, initialiser series, end symbol;
+
+  This function returns a BIND_EXPR.  */
+
+tree
+a68_lower_closed_clause (NODE_T *p, LOW_CTX_T ctx)
+{
+  /* Determine the mode of the closed clause.  */
+  MOID_T *clause_mode = MOID (p);
+  gcc_assert (clause_mode != NO_MOID);
+  gcc_assert (CTYPE (clause_mode) != NULL_TREE);
+
+  /* Lower the enclosed serial clause.
+
+     Note that a serial clause can be nested right inside another, and in that
+     case the range we are pushing corresponds to all of them, so we have to
+     keep this into account when determining whether using a DSA serial
+     range.  */
+
+  bool dsa = serial_clause_dsa (NEXT (SUB (p)));
+  bool local = NON_LOCAL (NEXT (SUB (p))) == NO_TABLE;
+  a68_push_serial_clause_range (clause_mode, dsa && local);
+  (void) a68_lower_tree (NEXT (SUB (p)), ctx);
+  return a68_pop_serial_clause_range ();
+}
+
+/* Lower an enclosed clause.
+
+     enclosed clause : parallel clause; closed clause;
+                       collateral clause; conditional clause;
+		       case clause; conformity clause;
+		       loop clause.
+*/
+
+tree
+a68_lower_enclosed_clause (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_lower_tree (SUB (p), ctx);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-coercions.cc
@@ -0,0 +1,471 @@
+/* Lower Algol 68 coercions to GENERIC.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Lower a dereferencing coercion.  */
+tree
+a68_lower_dereferencing (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_low_deref (a68_lower_tree (SUB (p), ctx), SUB (p));
+}
+
+/* Lower an uniting coercion.  */
+
+tree
+a68_lower_uniting (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree coercend_tree = a68_lower_tree (SUB (p), ctx);
+
+  if (MOID (p) == M_ROWS)
+    {
+      /* ROWS is a mode to which any ROW mode can be strongly coerced.  It is
+	 used as the mode of the second operand of the ELEMS, LWB and UPB
+	 operators.  The coercion is expressed in the parse tree via uniting.
+	 This results in replacing the multiple with a "rows" value that
+	 contains dimension and bounds information.  */
+      if (A68_ROW_TYPE_P (TREE_TYPE (coercend_tree)))
+	return a68_rows_value (coercend_tree);
+      else if (A68_UNION_TYPE_P (TREE_TYPE (coercend_tree)))
+	{
+	  /* coercend_tree is expanded more than once below.  */
+	  coercend_tree = save_expr (coercend_tree);
+
+	  /* Union of row modes.  We should create a rows value for the currently
+	     selected value.  */
+	  a68_push_range (M_ROWS);
+	  tree done_label = build_decl (UNKNOWN_LOCATION,
+					LABEL_DECL,
+					get_identifier ("done_label%"),
+					void_type_node);
+	  DECL_CONTEXT (done_label) = a68_range_context ();
+	  a68_add_decl (done_label);
+	  a68_add_decl_expr (fold_build1 (DECL_EXPR, TREE_TYPE (done_label), done_label));
+	  tree rows = a68_lower_tmpvar ("rows%", CTYPE (M_ROWS),
+					a68_get_skip_tree (M_ROWS));
+	  tree coercend_overhead = a68_union_overhead (coercend_tree);
+	  tree overhead = a68_lower_tmpvar ("overhead%", TREE_TYPE (coercend_overhead),
+					    coercend_overhead);
+	  int field_index = 0;
+	  for (tree field = TYPE_FIELDS (TREE_TYPE (a68_union_cunion (coercend_tree)));
+	       field;
+	       field = DECL_CHAIN (field))
+	    {
+	      a68_push_range (M_VOID);
+	      {
+		/* Set rows% to the rows value computed from coercend_tree.FIELD,
+		   which is of some multiple type.  */
+		a68_add_stmt (fold_build2 (MODIFY_EXPR, CTYPE (M_ROWS),
+					   rows,
+					   a68_rows_value (a68_union_alternative (coercend_tree,
+										  field_index))));
+		a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, done_label));
+		a68_add_stmt (a68_get_skip_tree (M_VOID));
+	      }
+	      tree process_entry = a68_pop_range ();
+
+	      /* IF overhead = field_index THEN rows% = rows_from_multiple FI */
+	      a68_add_stmt (fold_build3 (COND_EXPR,
+					 a68_void_type,
+					 fold_build2 (EQ_EXPR,
+						      TREE_TYPE (overhead),
+						      overhead,
+						      build_int_cst (TREE_TYPE (overhead), field_index)),
+					 process_entry,
+					 a68_get_skip_tree (M_VOID)));
+	      field_index += 1;
+	    }
+
+	  /* This should not be reached.  Emit run-time error.  */
+	  {
+	    unsigned int lineno = NUMBER (LINE (INFO (p)));
+	    const char *filename_str = FILENAME (LINE (INFO (p)));
+	    tree filename = build_string_literal (strlen (filename_str) + 1,
+						  filename_str);
+	    tree call = a68_build_libcall (A68_LIBCALL_UNREACHABLE,
+					   void_type_node, 2,
+					   filename,
+					   build_int_cst (unsigned_type_node, lineno));
+	    a68_add_stmt (call);
+	  }
+
+	  a68_add_stmt (build1 (LABEL_EXPR, void_type_node, done_label));
+	  a68_add_stmt (rows);
+	  return a68_pop_range ();
+	}
+      else
+	{
+	  debug_tree (TREE_TYPE (coercend_tree));
+	  gcc_assert (A68_ROWS_TYPE_P (TREE_TYPE (coercend_tree)));
+	  return coercend_tree;
+	}
+    }
+  else if (IS_UNION (MOID (SUB (p))))
+    {
+      /* We have to extract the value of the coercend union.  */
+      a68_push_range (MOID (p));
+      {
+	MOID_T *coercend_mode = MOID (SUB (p));
+	MOID_T *coercee_mode = MOID (p);
+
+	/* Temporaries for the coercend's components.  */
+	tree coercend = a68_lower_tmpvar ("coercend%", TREE_TYPE (coercend_tree), coercend_tree);
+	tree cval = a68_union_cunion (coercend);
+	tree coverhead = a68_union_overhead (coercend);
+	tree coercend_value = a68_lower_tmpvar ("coercend_value%", TREE_TYPE (cval), cval);
+	tree coercend_overhead = a68_lower_tmpvar ("coercend_overhead%", sizetype, coverhead);
+
+	/* Create the coercee.  */
+	tree coercee = a68_lower_tmpvar ("coercee%",
+					 CTYPE (MOID (p)),
+					 a68_get_skip_tree (MOID (p)));
+	tree coercee_value = a68_union_cunion (coercee);
+
+	/* First translate overhead.  This is crude, but it works.  */
+	int idx = 0;
+	tree coercee_overhead = size_zero_node;
+	while (EQUIVALENT (coercend_mode) != NO_MOID)
+	  coercend_mode = EQUIVALENT (coercend_mode);
+	for (PACK_T *pack = PACK (coercend_mode); pack != NO_PACK; FORWARD (pack))
+	  {
+	    coercee_overhead = fold_build3 (COND_EXPR,
+					    sizetype,
+					    fold_build2 (EQ_EXPR,
+							 sizetype,
+							 coercend_overhead,
+							 size_int (idx)),
+					    size_int (a68_united_mode_index (coercee_mode, MOID (pack))),
+					    coercee_overhead);
+	    idx++;
+	  }
+	a68_add_stmt (a68_union_set_overhead (coercee, coercee_overhead));
+
+	/* Now copy over the value.  This of course relies on the fact the
+	   value of the coercend is smaller or of the same size than the value
+	   of the built union.  */
+	a68_add_stmt (a68_lower_memcpy (fold_build1 (ADDR_EXPR,
+						     build_pointer_type (TREE_TYPE (coercee_value)),
+						     coercee_value),
+					fold_build1 (ADDR_EXPR,
+						     build_pointer_type (TREE_TYPE (coercend_value)),
+						     coercend_value),
+					size_in_bytes (TREE_TYPE (coercend_value))));
+	a68_add_stmt (coercee);
+      }
+      return a68_pop_range ();
+    }
+  else
+    {
+      /* Produce a united mode one of whose component modes is the mode of the
+	 coercend.  */
+      return a68_union_value (MOID (p), coercend_tree, MOID (SUB (p)));
+    }
+}
+
+/* Lower a rowing coercion.  */
+
+tree
+a68_lower_rowing (NODE_T *p, LOW_CTX_T ctx)
+{
+  MOID_T *mode = MOID (p);
+  bool did_deref = false;
+
+  /* If the primary is a REF, we need to dereference it to get the referred
+     value.  */
+  tree primary = NULL_TREE;
+  tree orig_primary = NULL_TREE;
+  MOID_T *target_mode = NO_MOID;
+  if (IS_REF (mode))
+    {
+      gcc_assert (IS_REF (MOID (SUB (p))));
+      did_deref = true;
+      target_mode = SUB (mode);
+
+      a68_push_range (mode);
+      /* Note that we have to consolidate because we need a pointer to compare
+	 to NIL below.  */
+      orig_primary = a68_lower_tmpvar ("orig_primary%",
+				       CTYPE (MOID (SUB (p))),
+				       a68_consolidate_ref (MOID (SUB (p)),
+							    a68_lower_tree (SUB (p), ctx)));
+      primary = a68_low_deref (orig_primary, SUB (p));
+    }
+  else
+    {
+      target_mode = mode;
+      primary = a68_lower_tree (SUB (p), ctx);
+      /* The primary gets expanded more than once below.  */
+      primary = save_expr (primary);
+    }
+
+  /* Perform the rowing in the primary. */
+  tree ssize_one_node = fold_convert (ssizetype, size_one_node);
+  tree rowed_primary = NULL_TREE;
+  if (DIM (DEFLEX (target_mode)) >= 2)
+    {
+      /* []A -> [,]A  */
+
+      /* First determine the number of dimensions of the resulting
+	 multiple.  */
+      tree primary_dimensions = a68_multiple_dimensions (primary);
+      gcc_assert (TREE_CODE (primary_dimensions) == INTEGER_CST);
+      int dim = tree_to_shwi (primary_dimensions) + 1;
+
+      /* Compute bounds.  */
+      tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * dim);
+      tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * dim);
+
+      lower_bounds[0] = ssize_one_node;
+      upper_bounds[0] = ssize_one_node;
+      for (int d = 1; d < dim; ++d)
+	{
+	  lower_bounds[d] = a68_multiple_lower_bound (primary, ssize_int (d - 1));
+	  upper_bounds[d] = a68_multiple_upper_bound (primary, ssize_int (d - 1));
+	}
+
+      rowed_primary = a68_row_value (CTYPE (target_mode), dim,
+				     a68_multiple_elements (primary),
+				     a68_multiple_elements_size (primary),
+				     lower_bounds, upper_bounds);
+      free (lower_bounds);
+      free (upper_bounds);
+    }
+  else
+    {
+      /* A -> []A  */
+      tree row_type = CTYPE (target_mode);
+      tree lower_bound = ssize_one_node;
+      tree upper_bound = ssize_one_node;
+      tree elements = (did_deref
+		       ? orig_primary
+		       : fold_build1 (ADDR_EXPR,
+				      build_pointer_type (TREE_TYPE (primary)),
+				      build_constructor_va (build_array_type (TREE_TYPE (primary),
+									      build_index_type (size_zero_node)),
+							    1, size_zero_node,  primary)));
+      tree elements_type = a68_row_elements_type (row_type);
+      tree elements_size = size_in_bytes (elements_type);
+      rowed_primary = a68_row_value (row_type, 1,
+				     elements, elements_size,
+				     &lower_bound, &upper_bound);
+    }
+
+  /* Build a ref if we rowed a ref.  */
+  if (did_deref)
+    {
+      tree pointer_type = build_pointer_type (TREE_TYPE (rowed_primary));
+      rowed_primary = fold_build1 (ADDR_EXPR, pointer_type, rowed_primary);
+      /* Rowing NIL yields NIL.  */
+      rowed_primary = fold_build3_loc (a68_get_node_location (p),
+				       COND_EXPR,
+				       pointer_type,
+				       fold_build2 (EQ_EXPR,
+						    pointer_type,
+						    fold_convert (pointer_type, orig_primary),
+						    build_int_cst (pointer_type, 0)),
+				       build_int_cst (pointer_type, 0),
+				       rowed_primary);
+      a68_add_stmt (rowed_primary);
+      rowed_primary = a68_pop_range ();
+    }
+
+  return rowed_primary;
+}
+
+/* Lower a widening coercion.
+
+   Widening allows the following conversions of mode:
+
+   LONGSETY INT to LONGSETY REAL
+   LONGSETY REAL to LONGSETY COMPL
+   LONGSETY BITS to []BOOL
+   LONGSETY BYTES to []CHAR  */
+
+tree
+a68_lower_widening (NODE_T *p, LOW_CTX_T ctx)
+{
+  if (MOID (p) == M_REAL
+      || MOID (p) == M_LONG_REAL
+      || MOID (p) == M_LONG_LONG_REAL)
+    {
+      return convert_to_real (CTYPE (MOID (p)), a68_lower_tree (SUB (p), ctx));
+    }
+  if (MOID (p) == M_COMPLEX
+      || MOID (p) == M_LONG_COMPLEX
+      || MOID (p) == M_LONG_LONG_COMPLEX)
+    {
+      return a68_complex_widen_from_real (MOID (p),
+					  a68_lower_tree (SUB (p), ctx));
+    }
+  else if (MOID (p) == M_ROW_BOOL)
+    {
+      /* Widen a LONGSETY BITS to a row of BOOLs.  */
+      tree coercend = a68_lower_tree (SUB (p), ctx);
+      tree coercend_type = TREE_TYPE (coercend);
+      HOST_WIDE_INT bits_size = int_size_in_bytes (coercend_type);
+      gcc_assert (bits_size != -1);
+      bits_size = bits_size * 8;
+
+      tree pointer_to_bool_type = build_pointer_type (a68_bool_type);
+      a68_push_range (M_ROW_BOOL);
+      /* First allocate space for the elements.  */
+      tree elements = a68_lower_tmpvar ("elements%",
+					pointer_to_bool_type,
+					a68_lower_alloca (a68_bool_type,
+							  fold_build2 (MULT_EXPR,
+								       sizetype,
+								       size_int (bits_size),
+								       size_in_bytes (a68_bool_type))));
+
+      /* Set the elements, each element is a BOOL which is TRUE if the
+	 corresponding bit in the coercend is set, FALSE otherwise.  */
+      tree coercend_one_node = build_int_cst (coercend_type, 1);
+      coercend = save_expr (coercend);
+      for (HOST_WIDE_INT bit = 0; bit < bits_size; ++bit)
+	{
+	  tree offset = fold_build2 (MULT_EXPR, sizetype,
+				     size_int (bit), size_in_bytes (a68_bool_type));
+	  tree bit_set = fold_convert (a68_bool_type,
+				       fold_build2 (BIT_AND_EXPR, coercend_type,
+						    fold_build2 (RSHIFT_EXPR, coercend_type,
+								 coercend,
+								 build_int_cst (coercend_type,
+										bits_size - 1 - bit)),
+						    coercend_one_node));
+
+	  a68_add_stmt (fold_build2 (MODIFY_EXPR,
+				     a68_bool_type,
+				     fold_build2 (MEM_REF,
+						  a68_bool_type,
+						  fold_build2 (POINTER_PLUS_EXPR,
+							       pointer_to_bool_type,
+							       elements,
+							       offset),
+						  fold_convert (pointer_to_bool_type,
+								integer_zero_node)),
+				     bit_set));
+	}
+
+      /* Create multiple.  */
+      tree lower_bound = ssize_int (1);
+      tree upper_bound = ssize_int (bits_size);
+      tree elements_size = fold_build2 (MULT_EXPR, sizetype,
+					size_int (bits_size),
+					size_in_bytes (a68_bool_type));
+      tree multiple = a68_row_value (CTYPE (M_ROW_BOOL), 1 /* dim */,
+				     elements, elements_size,
+				     &lower_bound, &upper_bound);
+      a68_add_stmt (multiple);
+      return a68_pop_range ();
+    }
+  else
+    {
+      fatal_error (a68_get_node_location (p),
+		   "cannot do widening from %s to %s",
+		   a68_moid_to_string (MOID (SUB (p)), MOID_ERROR_WIDTH, SUB (p)),
+		   a68_moid_to_string (MOID (p), MOID_ERROR_WIDTH, p));
+      gcc_unreachable ();
+    }
+}
+
+/* Lower a voiding coercion.
+
+   The voiding lowers into a compound expression with the voided expression
+   (for side-effects) and returns EMPTY.  */
+
+tree
+a68_lower_voiding (NODE_T *p, LOW_CTX_T ctx)
+{
+  return fold_build2_loc (a68_get_node_location (p),
+			  COMPOUND_EXPR,
+			  a68_void_type,
+			  a68_lower_tree (SUB (p), ctx),
+			  a68_get_empty ());
+}
+
+/* Lower a proceduring coercion.
+
+     proceduring : jump.
+
+   In the Revised language only jump statements can be procedured.  The
+   coercion results in a new function whose body is the jump instruction.  */
+
+tree
+a68_lower_proceduring (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree jump = a68_lower_tree (SUB (p), ctx);
+
+  tree procedured_goto = a68_make_anonymous_routine_decl (MOID (p));
+  a68_add_decl (procedured_goto);
+  a68_add_decl_expr (fold_build1_loc (a68_get_node_location (p),
+				      DECL_EXPR,
+				      TREE_TYPE (procedured_goto),
+				      procedured_goto));
+  announce_function (procedured_goto);
+
+  a68_push_function_range (procedured_goto, CTYPE (SUB (MOID (p))));
+  a68_pop_function_range (jump);
+  return fold_build1 (ADDR_EXPR,
+		      build_pointer_type (TREE_TYPE (procedured_goto)),
+		      procedured_goto);
+}
+
+/* Lower a deproceduring coercion.
+   The deproceduring lowers into a call expression.  */
+
+tree
+a68_lower_deproceduring (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree func = a68_lower_tree (SUB (p), ctx);
+
+  if (POINTER_TYPE_P (TREE_TYPE (func)))
+    {
+      if (TREE_CODE (func) == ADDR_EXPR)
+	func = TREE_OPERAND (func, 0);
+      else
+	func = fold_build1 (INDIRECT_REF,
+			    TREE_TYPE (TREE_TYPE (func)),
+			    func);
+    }
+
+  return build_call_expr_loc (a68_get_node_location (p), func, 0);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-complex.cc
@@ -0,0 +1,141 @@
+/* Lowering routines for all things related to COMPL values.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Build a new COMPL value with real part RE and imaginary part IM, of mode
+   MODE.  */
+
+tree
+a68_complex_i (MOID_T *mode, tree re, tree im)
+{
+  tree compl_type = CTYPE (mode);
+
+  tree re_field = TYPE_FIELDS (compl_type);
+  tree im_field = TREE_CHAIN (re_field);
+  return build_constructor_va (CTYPE (mode), 2,
+			       re_field, re,
+			       im_field, im);
+}
+
+/* Given a COMPL value Z, get its real part.  */
+
+tree
+a68_complex_re (tree z)
+{
+  tree re_field = TYPE_FIELDS (TREE_TYPE (z));
+  return fold_build3 (COMPONENT_REF, TREE_TYPE (re_field),
+		      z, re_field, NULL_TREE);
+}
+
+tree
+a68_complex_im (tree z)
+{
+  tree im_field = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (z)));
+  return fold_build3 (COMPONENT_REF, TREE_TYPE (im_field),
+		      z, im_field, NULL_TREE);
+}
+
+/* Return the conjugate of the given complex Z of mode MODE.  */
+
+tree
+a68_complex_conj (MOID_T *mode, tree z)
+{
+  tree re_field = TYPE_FIELDS (TREE_TYPE (z));
+  tree complex_type = build_complex_type (TREE_TYPE (re_field), false /* named */);
+
+  z = save_expr (z);
+  tree complex = fold_build2 (COMPLEX_EXPR, complex_type,
+			      a68_complex_re (z), a68_complex_im (z));
+  tree conj = fold_build1 (CONJ_EXPR, TREE_TYPE (complex), complex);
+
+  return a68_complex_i (mode,
+			fold_build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (z)), conj),
+			fold_build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (z)), conj));
+}
+
+/* Widen a real R to a complex of mode MODE.  */
+
+tree
+a68_complex_widen_from_real (MOID_T *mode, tree r)
+{
+  tree compl_type = CTYPE (mode);
+  gcc_assert (compl_type != NULL_TREE);
+
+  /* Sanity check.  */
+  if (mode == M_COMPLEX)
+    gcc_assert (TREE_TYPE (r) == a68_real_type);
+  else if (mode == M_LONG_COMPLEX)
+    gcc_assert (TREE_TYPE (r) == a68_long_real_type);
+  else if (mode == M_LONG_LONG_COMPLEX)
+    gcc_assert (TREE_TYPE (r) == a68_long_long_real_type);
+  else
+    gcc_unreachable ();
+
+  a68_push_range (mode);
+  tree res = a68_lower_tmpvar ("compl%", compl_type,
+			       a68_get_skip_tree (mode));
+
+  /* Look for the "re" field.  */
+  tree field_id = a68_get_mangled_identifier ("re");
+  tree field = NULL_TREE;
+  for (tree f = TYPE_FIELDS (compl_type); f; f = DECL_CHAIN (f))
+    {
+      if (field_id == DECL_NAME (f))
+	{
+	  field = f;
+	  break;
+	}
+    }
+  gcc_assert (field != NULL_TREE);
+
+  /* Set it to the given real value.  */
+  a68_add_stmt (fold_build2 (MODIFY_EXPR,
+			     TREE_TYPE (r),
+			     fold_build3 (COMPONENT_REF,
+					  TREE_TYPE (field),
+					  res, field,
+					  NULL_TREE),
+			     r));
+  a68_add_stmt (res);
+  return a68_pop_range ();
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-decls.cc
@@ -0,0 +1,629 @@
+/* Lower mode, identity and variable declarations to GENERIC.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Lower one or more mode declarations.
+
+     mode declaration : mode symbol, defining indicant,
+                        equals symbol, declarer;
+                        mode symbol, defining indicant,
+			equals symbol, void symbol;
+                        mode declaration, comma symbol,
+			defining indicant, equals symbol, declarer;
+                        mode declaration, comma symbol,
+			defining indicant, equals symbol, void symbol.
+
+   Each mode declaration lowers into a TYPE_DECL, which are chained in the
+   current block.  This function returns void_node.
+
+   Note that the defining indicant is already annotated with the declared mode
+   so there is no need to go hunting for the declarer in the subtree.  */
+
+tree
+a68_lower_mode_declaration (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *defining_indicant = NO_NODE;
+
+  if (IS (SUB (p), MODE_DECLARATION))
+    {
+      a68_lower_tree (SUB (p), ctx);
+      defining_indicant = NEXT (NEXT (SUB (p)));
+    }
+  else
+    {
+      gcc_assert (IS (SUB (p), MODE_SYMBOL));
+      defining_indicant = NEXT (SUB (p));
+    }
+
+  /* Create a TYPE_DECL declaration for the defined mode and chain it in the
+     current block.  */
+  tree ctype = CTYPE (MOID (defining_indicant));
+  tree decl_name = a68_get_mangled_identifier (NSYMBOL (defining_indicant));
+  tree decl = build_decl (a68_get_node_location (p),
+			  TYPE_DECL, decl_name, ctype);
+  SET_DECL_ASSEMBLER_NAME (decl, decl_name);
+  TREE_PUBLIC (decl) = 1;
+  TYPE_CONTEXT (ctype) = DECL_CONTEXT (decl);
+  TYPE_NAME (ctype) = decl;
+  TYPE_STUB_DECL (ctype) = decl;
+  a68_add_decl (decl);
+
+  return void_node;
+}
+
+/* Lower one or more variable declarations.
+
+     variable declaration : qualifier, declarer, defining identifier,
+                            assign symbol, unit;
+     			    qualifier, declarer, defining identiifer;
+			    qualifier, declarer, defining identifier;
+			    declarer, defining identifier, assign symbol, unit;
+			    declarer, defining identifier;
+			    variable declaration, comma symbol,
+			    defining identifier, assign symbol, unit;
+			    variable declaration, comma symbol,
+			    defining identifier;
+
+  Each variable declaration lowers into a VAR_DECL, which are chained in the
+  current block.  This function also returns an expression with code to
+  initialize the variable in case there is an initializer.
+
+  If the variable declaration implies a LOC generator then the VAR_DECL for REF
+  AMODE declares a value of type CTYPE (AMODE).  This is an optimization in
+  order to avoid indirect addressing.  If the variable declaration implies a
+  HEAP generator, however, then the VAR_DECL declares a value of type pointer
+  to CTYPE (AMODE0.  In this later case no optimization is possible and it has
+  exactly the same effect than an identity declaration `REF AMODE
+  defining_identifier = HEAP AMODE'.
+
+  Note that the defining identifier is annotated with its mode, so there is no
+  need to go hunting for the declarer in the subtree.  */
+
+tree
+a68_lower_variable_declaration (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *defining_identifier, *unit;
+  NODE_T *declarer = NO_NODE;
+
+  tree sub_expr = NULL_TREE;
+
+  if (IS (SUB (p), VARIABLE_DECLARATION))
+    {
+      LOW_CTX_T new_ctx = ctx;
+      new_ctx.declarer = &declarer;
+      sub_expr = a68_lower_tree (SUB (p), new_ctx);
+      defining_identifier = NEXT (NEXT (SUB (p)));
+    }
+  else if (IS (SUB (p), QUALIFIER))
+    {
+      /* The qualifier determines what kind of generator is used in the
+	 variable declaration.  This is already annotated in the tax entry for
+	 the definining identifier.  */
+      declarer = NEXT (SUB (p));
+      defining_identifier = NEXT (NEXT (SUB (p)));
+    }
+  else if (IS (SUB (p), DECLARER))
+    {
+      declarer = SUB (p);
+      defining_identifier = NEXT (SUB (p));
+    }
+  else
+    gcc_unreachable ();
+
+  /* Communicate declarer upward.  */
+  if (ctx.declarer != NULL)
+    *ctx.declarer = declarer;
+
+  /* See if this variable declaration features an initializing unit.  */
+  if (NEXT (defining_identifier) != NO_NODE)
+    {
+      gcc_assert (NEXT (defining_identifier)
+		  && IS (NEXT (defining_identifier), ASSIGN_SYMBOL)
+		  && NEXT (NEXT (defining_identifier)));
+      unit = NEXT (NEXT (defining_identifier));
+    }
+  else
+    unit = NO_NODE;
+
+  /* If not done already by an applied identifier in lower_identifier, create a
+     declaration for the defined entity and chain it in the current block.  The
+     declaration has an initial value of SKIP.  */
+  tree var_decl = TAX_TREE_DECL (TAX (defining_identifier));
+  if (var_decl == NULL_TREE)
+    {
+      var_decl = a68_make_variable_declaration_decl (defining_identifier);
+      TAX_TREE_DECL (TAX (defining_identifier)) = var_decl;
+    }
+
+  /* Chain declaration in current block and bind.  */
+  a68_add_decl (var_decl);
+
+  /* Add a decl_expr in the current range.  */
+  a68_add_decl_expr (fold_build1_loc (a68_get_node_location (p),
+				      DECL_EXPR,
+				      TREE_TYPE (var_decl),
+				      var_decl));
+
+  tree expr = NULL_TREE;
+
+  /* If the variable is heap allocated or has rows, the var_decl created above
+     is a pointer.  Run a generator to get the memory with descriptors filled
+     in.  Note that we cannot set the pointer as the initial of the var_decl
+     because the bounds in the actual declarer shall be elaborated at the point
+     of the code where the declaration appears, not at the beginning of its
+     reach.  Note that the mode of the declarer will be always a REF since this
+     is a variable declaration: the referred mode is what we pass to
+     a68_low_generator.  */
+  bool heap = HEAP (TAX (defining_identifier)) == HEAP_SYMBOL;
+  if (heap || HAS_ROWS (SUB (MOID (defining_identifier))))
+    {
+      gcc_assert(IS_REF (MOID (declarer)));
+      expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (var_decl),
+			  var_decl,
+			  a68_low_generator (declarer,
+					     SUB (MOID (declarer)),
+					     heap, ctx));
+    }
+
+  if (unit != NO_NODE)
+    {
+      tree rhs = a68_lower_tree (unit, ctx);
+      tree assignation = a68_low_assignation (p,
+					      var_decl, MOID (defining_identifier),
+					      rhs, MOID (unit));
+      if (expr != NULL_TREE)
+	expr = fold_build2_loc (a68_get_node_location (p),
+				COMPOUND_EXPR,
+				TREE_TYPE (assignation),
+				expr, assignation);
+      else
+	expr = assignation;
+    }
+
+  /* Tail in a compound expression with sub declarations, if any.  */
+  if (sub_expr != NULL_TREE)
+    {
+      if (expr != NULL_TREE)
+	expr = fold_build2_loc (a68_get_node_location (p),
+				COMPOUND_EXPR,
+				TREE_TYPE (var_decl),
+				sub_expr,
+				expr);
+      else
+	expr = sub_expr;
+    }
+
+  return expr;
+}
+
+/* Lower one or more identity declarations.
+
+     identity declaration : declarer, defining identifier,
+                            equals symbol, unit;
+                            identity declaration, comma symbol,
+			    defining identifier, equals symbol, unit;
+
+   Each identity declaration lowers into a declaration.
+
+   VAR_DECL with both TREE_CONSTANT and TREE_READONLY set.  Note that we cannot
+   use CONST_DECL because of two reasons.  First, CONST_DECL only works for
+   scalar modes.  Second, since Algol 68 allows usage of identifiers before
+   they get declared, each declaration adds a declaration with a SKIP initial
+   value, and also an assignation of the value at the declaration point.  This
+   function also returns an expression with code to initialize the declared
+   constant.  */
+
+tree
+a68_lower_identity_declaration (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree unit_tree = NULL_TREE;
+  tree sub_expr = NULL_TREE;
+
+  /* Note that the formal declarer in the construct is not used.  This is
+     because it is already reflected in the mode of the identity
+     declaration.  */
+
+  NODE_T *defining_identifier;
+  if (IS (SUB (p), IDENTITY_DECLARATION))
+    {
+      sub_expr = a68_lower_tree (SUB (p), ctx);
+      defining_identifier = NEXT (NEXT (SUB (p)));
+    }
+  else if (IS (SUB (p), DECLARER))
+    {
+      defining_identifier = NEXT (SUB (p));
+    }
+  else
+    gcc_unreachable ();
+
+  NODE_T *unit = NEXT (NEXT (defining_identifier));
+
+  /* If not done already by an applied identifier in lower_identifier, create a
+     declaration for the defined entity and chain it in the current block.  The
+     declaration has an initial value of SKIP.  */
+  tree id_decl = TAX_TREE_DECL (TAX (defining_identifier));
+  if (id_decl == NULL_TREE)
+    {
+      id_decl = a68_make_identity_declaration_decl (defining_identifier);
+      TAX_TREE_DECL (TAX (defining_identifier)) = id_decl;
+    }
+
+  /* Chain declaration in current block and bind.  */
+  a68_add_decl (id_decl);
+  /* Prepare the DECL_EXPR.  */
+  a68_add_decl_expr (fold_build1_loc (a68_get_node_location (p),
+				      DECL_EXPR,
+				      TREE_TYPE (id_decl),
+				      id_decl));
+
+  unit_tree = a68_lower_tree (unit, ctx);
+  unit_tree = a68_consolidate_ref (MOID (unit), unit_tree);
+  tree expr = a68_low_ascription (MOID (defining_identifier),
+				  id_decl, unit_tree);
+
+  /* If the ascribed value is constant, mark the declaration as constant.  */
+  TREE_CONSTANT (id_decl) = TREE_CONSTANT (unit_tree);
+
+  /* Tail in a compound expression with sub declarations, if any.  */
+  if (sub_expr != NULL_TREE)
+    {
+      if (expr != NULL_TREE)
+	expr = fold_build2_loc (a68_get_node_location (p),
+				COMPOUND_EXPR,
+				TREE_TYPE (id_decl),
+				sub_expr,
+				expr);
+      else
+	expr = sub_expr;
+    }
+
+  return expr;
+}
+
+/* Lower a declarer.
+
+     declarer : indicant;
+     		longety, indicant;
+     		shortety, indicant;
+		flex symbol, declarer;
+		flex symbol, bounds, declarer;
+		flex symbol, formal bounds, declarer;
+		bounds, declarer;
+		formal bounds, declarer;
+                ref symbol, declarer;
+		struct symbol, structure pack;
+		union symbol, union pack;
+                proc symbol, declarer;
+		proc symbol, formal declarers, declarer;
+		proc symbol, formal declarers, void symbol;
+
+
+  This handler lowes a DECLARER tree into an expression that evaluates to the
+  size of the actual declarer.  Note that this is a self-contained handler and
+  it does traverse the sub-tree on its own.  */
+
+tree
+a68_lower_declarer (NODE_T *p ATTRIBUTE_UNUSED,
+		    LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  gcc_unreachable ();
+}
+
+/* Lower a declaration list.
+
+    declaration list : mode declaration;
+                       priority declaration;
+                       brief operator declaration;
+                       operator declaration;
+                       identity declaration;
+                       procedure declaration;
+                       procedure variable declaration;
+                       variable declaration;
+                       environ name;
+		       declaration list, comma symbol, declaration list;
+
+   Process the subtree, which produces declarations associated with the current
+   context and which get added to the current block.  The list of declarations
+   gets returned in nested compound expressions.  */
+
+tree
+a68_lower_declaration_list (NODE_T *p, LOW_CTX_T ctx)
+{
+  if (IS (SUB (p), DECLARATION_LIST))
+    {
+      tree left = a68_lower_tree (SUB (p), ctx);
+      tree right = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+      /* The trees `left' and `right' may be NULL_TREE if the declarations
+	 under them didn't have an initializing expression.  In that case,
+	 replace them by nops which are removed at fold time.  This is ugly,
+	 but works.  */
+      if (left == NULL_TREE)
+	left = integer_zero_node;
+      if (right == NULL_TREE)
+	right = integer_zero_node;
+
+      return fold_build2_loc (a68_get_node_location (p),
+			      COMPOUND_EXPR,
+			      void_type_node,
+			      left, right);
+    }
+  else
+    return a68_lower_tree (SUB (p), ctx);
+}
+
+/* Lower a procedure declaration.
+
+     procedure declaration : proc symbol, defining identifier, assign symbol, routine text;
+                             procedure declaration, comma symbol,
+			     defining identifier, equals symbol, routine text.
+
+   Each procedure declaration lowers into a declaration.  */
+
+tree
+a68_lower_procedure_declaration (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree sub_func_decl = NULL_TREE;
+  NODE_T *defining_identifier;
+  if (IS (SUB (p), PROCEDURE_DECLARATION))
+    {
+      sub_func_decl = a68_lower_tree (SUB (p), ctx);
+      defining_identifier = NEXT (NEXT (SUB (p)));
+    }
+  else if (IS (SUB (p), PROC_SYMBOL))
+    {
+      defining_identifier = NEXT (SUB (p));
+    }
+  else
+    gcc_unreachable ();
+
+  NODE_T *routine_text = NEXT (NEXT (defining_identifier));
+
+  /* Lower the routine text to get a function decl.  */
+  ctx.proc_decl_identifier = defining_identifier;
+  tree func_decl = a68_lower_tree (routine_text, ctx);
+
+  /* Tail in a compound expression with sub declarations, if any.  */
+  if (sub_func_decl != NULL_TREE)
+    {
+      if (func_decl != NULL_TREE)
+	func_decl = fold_build2_loc (a68_get_node_location (p),
+				     COMPOUND_EXPR,
+				     TREE_TYPE (func_decl),
+				     sub_func_decl,
+				     func_decl);
+      else
+	func_decl = sub_func_decl;
+    }
+
+  return func_decl;
+}
+
+/* Lower a procedure variable declaration.
+
+     procedure variable declaration
+       : proc symbol, defining identifier, assign symbol, routine text;
+         qualifier, proc symbol, defining identifier, assign symbol, routine text;
+	 procedure variable declaration, comma symbol, defining identiier, assign symbol, routine text.
+
+   This lowers into the declaration of a VAR_DECL which is a pointer to the
+   free standing routine yielded by the routine text.  */
+
+tree
+a68_lower_procedure_variable_declaration (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree sub_decl = NULL_TREE;
+  NODE_T *defining_identifier;
+  if (IS (SUB (p), PROCEDURE_VARIABLE_DECLARATION))
+    {
+      sub_decl = a68_lower_tree (SUB (p), ctx);
+      defining_identifier = NEXT (NEXT (SUB (p)));
+    }
+  else if (IS (SUB (p), PROC_SYMBOL))
+    defining_identifier = NEXT (SUB (p));
+  else if (IS (SUB (p), QUALIFIER))
+    /* The qualifier determines what kind of generator is used in the variable
+       declaration.  This is already annotated in the tax entry for the
+       definining identifier.  */
+    defining_identifier = NEXT (NEXT (SUB (p)));
+  else
+    gcc_unreachable ();
+  NODE_T *routine_text = NEXT (NEXT (defining_identifier));
+
+  /* The routine text lowers into a pointer to function.  */
+  ctx.proc_decl_identifier = NO_NODE;
+  tree routine = a68_lower_tree (routine_text, ctx);
+
+  /* Create a declaration for the proc variable, if that hasn't been done
+     already.  */
+  tree decl = TAX_TREE_DECL (TAX (defining_identifier));
+  if (decl == NULL_TREE)
+    {
+      decl = a68_make_variable_declaration_decl (defining_identifier);
+      TAX_TREE_DECL (TAX (defining_identifier)) = decl;
+    }
+
+  /* Chain declaration in current block and bind.  */
+  a68_add_decl (decl);
+  /* Add a decl_expr in the current range.  */
+  a68_add_decl_expr (fold_build1_loc (a68_get_node_location (p),
+				      DECL_EXPR,
+				      TREE_TYPE (decl),
+				      decl));
+  /* Initialize.
+
+     If the variable is heap allocated then the var_decl created above is a
+     pointer.  We don't allocate the actual function on the heap, because the
+     scope of procedures is not global.  */
+  bool heap = HEAP (TAX (defining_identifier)) == HEAP_SYMBOL;
+  a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (decl), decl,
+			     heap ? fold_build1 (ADDR_EXPR, TREE_TYPE (decl),
+						 routine) : routine));
+
+  /* Tail in a compound expression with sub declarations, if any.  */
+  if (sub_decl != NULL_TREE)
+    {
+      if (decl != NULL_TREE)
+	decl = fold_build2_loc (a68_get_node_location (p),
+				COMPOUND_EXPR,
+				TREE_TYPE (decl),
+				sub_decl,
+				decl);
+      else
+	decl = sub_decl;
+    }
+
+  return decl;
+}
+
+/* Lower a priority declaration.
+
+   This lowers to nothing.  Operator priority is fully handled by the parser in
+   order to decide which operator declaration corresponds to each applied
+   operator.  */
+
+tree
+a68_lower_priority_declaration (NODE_T *p ATTRIBUTE_UNUSED,
+				LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return NULL_TREE;
+}
+
+/* Lower a brief operator declaration.
+
+     brief operator declaration
+       : op symbol, defining operator, equals symbol, routine text;
+         brief operator declaration, comma symbol, defining operator, equals symbol, routine text.
+
+   The declarations low in a series of FUNCTION_DECLs, one per declared
+   operator.  */
+
+tree
+a68_lower_brief_operator_declaration (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree sub_func_decl = NULL_TREE;
+  NODE_T *defining_operator;
+
+  if (IS (SUB (p), BRIEF_OPERATOR_DECLARATION))
+    {
+      sub_func_decl = a68_lower_tree (SUB (p), ctx);
+      defining_operator = NEXT (NEXT (SUB (p)));
+    }
+  else
+    defining_operator = NEXT (SUB (p));
+  NODE_T *routine_text = NEXT (NEXT (defining_operator));
+
+  /* Lower the routine text to get a function decl.  */
+  ctx.proc_decl_identifier = defining_operator;
+  tree func_decl = a68_lower_tree (routine_text, ctx);
+
+  /* Tail in a compound expression with sub declarations, if any.  */
+  if (sub_func_decl != NULL_TREE)
+    {
+      if (func_decl != NULL_TREE)
+	func_decl = fold_build2_loc (a68_get_node_location (p),
+				     COMPOUND_EXPR,
+				     TREE_TYPE (func_decl),
+				     sub_func_decl,
+				     func_decl);
+      else
+	func_decl = sub_func_decl;
+    }
+
+  return func_decl;
+}
+
+/* Lower an operator declaration.
+
+     operator declaration : operator plan, defining operator, equals symbol, unit;
+                            operator declaration, comma symbol, defining operator, equals symbol, unit.
+
+   Each operator declaration lowers into a declaration.  */
+
+tree
+a68_lower_operator_declaration (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree sub_op_decl = NULL_TREE;
+  NODE_T *defining_operator;
+
+  if (IS (SUB (p), OPERATOR_DECLARATION))
+    {
+      sub_op_decl = a68_lower_tree (SUB (p), ctx);
+      defining_operator = NEXT (NEXT (SUB (p)));
+    }
+  else
+    defining_operator = NEXT (SUB (p));
+  NODE_T *unit = NEXT (NEXT (defining_operator));
+
+  tree op_decl = TAX_TREE_DECL (TAX (defining_operator));
+  if (op_decl == NULL_TREE)
+    {
+      op_decl = a68_make_identity_declaration_decl (defining_operator);
+      TAX_TREE_DECL (TAX (defining_operator)) = op_decl;
+    }
+
+  /* Chain declaration in current block and bind and emit DECL_EXPR.  */
+  a68_add_decl (op_decl);
+  a68_add_decl_expr (fold_build1_loc (a68_get_node_location (p),
+				      DECL_EXPR,
+				      TREE_TYPE (op_decl),
+				      op_decl));
+  /* Initialize.  */
+  a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (op_decl), op_decl,
+			     a68_lower_tree (unit, ctx)));
+
+  /* Tail in a compound expression with sub declarations, if any.  */
+  if (sub_op_decl != NULL_TREE)
+    {
+      if (op_decl != NULL_TREE)
+	op_decl = fold_build2_loc (a68_get_node_location (p),
+				   COMPOUND_EXPR,
+				   TREE_TYPE (op_decl),
+				   sub_op_decl,
+				   op_decl);
+      else
+	op_decl = sub_op_decl;
+    }
+
+  return op_decl;
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-generator.cc
@@ -0,0 +1,533 @@
+/* Lower generators.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+
+typedef tree (*allocator_t) (tree, tree);
+
+/* Lower to code that fill in BOUNDS and elements pointers in the given buffer
+   pointed by BUFFER at offset OFFSET according to the mode MODE, and evals to
+   BUFFER.  */
+
+static tree
+fill_in_buffer (tree buffer, tree offset, tree_stmt_iterator *bounds, MOID_T *m,
+		allocator_t allocator)
+{
+  tree filler = NULL_TREE;
+  tree type = CTYPE (m);
+  tree pointer_type = build_pointer_type (type);
+
+  a68_push_stmt_list (M_VOID);
+
+  if (m == M_INT || m == M_BOOL || m == M_CHAR || m == M_REAL || IS_REF (m))
+    {
+      tree val_address = fold_build2 (POINTER_PLUS_EXPR, pointer_type, buffer, offset);
+      tree init_val = a68_get_skip_tree (m);
+      tree modify = fold_build2 (MODIFY_EXPR,
+				 type,
+				 fold_build1 (INDIRECT_REF, type, val_address),
+				 init_val);
+      a68_add_stmt (modify);
+    }
+  else if (!HAS_ROWS (m))
+    {
+      /* This mode has no rows.  We can just fill in with zeroes, which
+	 translates into SKIP values for all possibly contained types.  */
+      tree call = builtin_decl_explicit (BUILT_IN_MEMSET);
+      call = build_call_expr_loc (UNKNOWN_LOCATION, call, 3,
+				  buffer,
+				  integer_zero_node,
+				  fold_convert (sizetype, size_in_bytes (CTYPE (m))));
+      a68_add_stmt (call);
+    }
+  else if (m == M_STRING)
+    {
+      /* Strings are rows but handled especially as they are created empty and
+	 don't feature bounds in the formal declarer.  */
+
+      /* First the descriptor.  */
+      tree pointer_byte_size = size_int (POINTER_SIZE / BITS_PER_UNIT);
+      tree lb_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset);
+      a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node,
+				 fold_build1 (INDIRECT_REF, ssizetype, lb_address),
+				 ssize_int (1)));
+      offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size);
+      tree ub_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset);
+      a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node,
+				 fold_build1 (INDIRECT_REF, ssizetype, ub_address),
+				 ssize_int (0)));
+      offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size);
+      tree stride_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset);
+      a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node,
+				 fold_build1 (INDIRECT_REF, sizetype, stride_address),
+				 size_in_bytes (a68_char_type)));
+
+      /* The data is an empty string, i.e NULL.  */
+      offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size);
+      tree elems_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset);
+      a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node,
+				 fold_build1 (INDIRECT_REF, build_pointer_type (a68_char_type),
+					      elems_address),
+				 build_int_cst (build_pointer_type (a68_char_type), 0)));
+
+      /* The size of the elements is zero.  */
+      offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size);
+      tree elems_size_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset);
+      a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node,
+				 fold_build1 (INDIRECT_REF, build_pointer_type (a68_char_type),
+					      elems_size_address),
+				 size_zero_node));
+    }
+  else if (A68_ROW_TYPE_P (type))
+    {
+      /* If the row mode is flexible we can deflex it now: these also must have
+	 bounds specified for them, with the only exception of strings/flexible
+	 rows of chars, which are handled above.  Note we cannot use DEFLEXED
+	 here because that contains the fully deflexed mode.  For example,
+	 DEFLEXED returns [][]INT for FLEX[]FLEX[]INT, and we want []FLEX[]INT
+	 instead.  */
+      if (IS_FLEX (m))
+	m = SUB (m);
+
+      /* Consume two bounds from BOUNDS for each dimension and patch them at
+	 their right offsets.  Note that we have to process from upper
+	 dimension to lower dimension so we can calculate the stride as we
+	 go.  */
+      size_t dim = DIM (m);
+
+      /* Collect lower and upper bounds and calculate the number of elements of
+	 the multiple.  */
+      tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * dim);
+      tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * dim);
+      tree num_elems = NULL_TREE;
+      for (size_t i = 0; i < dim; ++i)
+	{
+	  /* Note we have to convert the bounds from CTYPE(M_INT) to
+	     ssizetype.  */
+	  lower_bounds[i] = fold_convert (ssizetype, save_expr (tsi_stmt (*bounds)));
+	  tsi_next (bounds);
+	  upper_bounds[i] = fold_convert (ssizetype, save_expr (tsi_stmt (*bounds)));
+	  tsi_next (bounds);
+
+	  tree dim_num_elems
+	    = fold_build2 (PLUS_EXPR, sizetype,
+			   fold_convert (sizetype,
+					 fold_build2 (MINUS_EXPR, ssizetype,
+						      upper_bounds[i], lower_bounds[i])),
+			   size_one_node);
+	  dim_num_elems = fold_build3 (COND_EXPR,
+				       sizetype,
+				       fold_build2 (LT_EXPR, ssizetype,
+						    upper_bounds[i], lower_bounds[i]),
+				       size_zero_node,
+				       dim_num_elems);
+	  if (num_elems == NULL_TREE)
+	    num_elems = dim_num_elems;
+	  else
+	    num_elems = fold_build2 (MULT_EXPR, sizetype, num_elems, dim_num_elems);
+	}
+
+      /* Calculate strides.  */
+      tree *strides = (tree *) xmalloc (sizeof (tree) * dim);
+      a68_multiple_compute_strides (type, dim, lower_bounds, upper_bounds, strides);
+
+      /* Now emit instructions to patch the bounds and strides.  */
+      tree pointer_byte_size = size_int (POINTER_SIZE / BITS_PER_UNIT);
+      for (size_t i = 0; i < dim; ++i)
+	{
+	  /* Lower bound.  */
+	  tree lb_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset);
+	  a68_add_stmt (fold_build2 (MODIFY_EXPR,
+				     void_type_node,
+				     fold_build1 (INDIRECT_REF, ssizetype, lb_address),
+				     lower_bounds[i]));
+	  /* Upper bound.  */
+	  offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size);
+	  tree ub_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset);
+	  a68_add_stmt (fold_build2 (MODIFY_EXPR,
+				     void_type_node,
+				     fold_build1 (INDIRECT_REF, ssizetype, ub_address),
+				     upper_bounds[i]));
+	  /* Stride.  */
+	  offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size);
+	  tree stride_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset);
+	  a68_add_stmt (fold_build2 (MODIFY_EXPR,
+				     void_type_node,
+				     fold_build1 (INDIRECT_REF, sizetype, stride_address),
+				     strides[i]));
+	  offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size);
+	}
+      free (lower_bounds);
+      free (upper_bounds);
+      free (strides);
+
+      /* Now allocate space for the elements.  */
+      MOID_T *elem_mode = SUB (m);
+      tree elem_size = fold_convert (sizetype, size_in_bytes (CTYPE (elem_mode)));
+      tree elems_size = save_expr (fold_build2 (MULT_EXPR, sizetype, elem_size, num_elems));
+      tree elemsptr = (*allocator) (CTYPE (elem_mode), elems_size);
+      elemsptr = save_expr (elemsptr);
+
+      /* And initialize them.  */
+      if (elem_mode == M_INT || elem_mode == M_BOOL || elem_mode == M_CHAR
+	  || elem_mode == M_REAL || IS_REF (elem_mode))
+	{
+	  /* Memsetting the buffer with either zeroes or ones satisfies the
+	     SKIP value for these modes.  */
+	  tree call = builtin_decl_explicit (BUILT_IN_MEMSET);
+	  call = build_call_expr_loc (UNKNOWN_LOCATION, call, 3,
+				      elemsptr,
+				      integer_zero_node,
+				      elems_size);
+	  a68_add_stmt (call);
+	}
+      else
+	{
+	  /* Recurse in a loop to fill in elements.  */
+	  a68_push_range (NULL);
+	  tree num_elems_var = a68_lower_tmpvar ("numelems%", size_type_node,
+						 num_elems);
+	  tree index = a68_lower_tmpvar ("index%", size_type_node, size_zero_node);
+	  tree elems_var = a68_lower_tmpvar ("elems%", TREE_TYPE (elemsptr),
+					     elemsptr);
+	  tree elem_offset = a68_lower_tmpvar ("elem_offset%", size_type_node,
+					       size_zero_node);
+
+	  /* Begin of loop body.  */
+	  a68_push_range (NULL);
+	  a68_add_stmt (fold_build1 (EXIT_EXPR,
+				     void_type_node,
+				     fold_build2 (EQ_EXPR,
+						  size_type_node,
+						  index, num_elems_var)));
+	  a68_add_stmt (fill_in_buffer (elems_var, elem_offset, bounds, elem_mode,
+					allocator));
+	  /* Increase elem_offset  */
+	  a68_add_stmt (fold_build2 (MODIFY_EXPR, sizetype,
+				     elem_offset,
+				     fold_build2 (PLUS_EXPR, sizetype,
+						  elem_offset, elem_size)));
+	  /* index++ */
+	  a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR,
+				     size_type_node,
+				     index, size_one_node));
+	  tree loop_body = a68_pop_range ();
+	  /* End of loop body.  */
+	  a68_add_stmt (fold_build1 (LOOP_EXPR,
+				     void_type_node,
+				     loop_body));
+	  a68_add_stmt (a68_pop_range ());
+	}
+
+      /* Patch the elements% field.  */
+      tree elems_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset);
+      a68_add_stmt (fold_build2 (MODIFY_EXPR,
+				 void_type_node,
+				 fold_build1 (INDIRECT_REF,
+					      build_pointer_type (CTYPE (elem_mode)), elems_address),
+				 elemsptr));
+      /* Patch the elements_size% field.  */
+      offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size);
+      tree elems_size_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset);
+      a68_add_stmt (fold_build2 (MODIFY_EXPR,
+				 void_type_node,
+				 fold_build1 (INDIRECT_REF,
+					      sizetype,
+					      elems_size_address),
+				 elems_size));
+    }
+  else if (A68_STRUCT_TYPE_P (type))
+    {
+      /* Initialize the struct's fields in the allocated buffer.  */
+      tree base = a68_lower_tmpvar ("base%", TREE_TYPE (buffer),
+				    fold_build2 (POINTER_PLUS_EXPR,
+						 TREE_TYPE (buffer),
+						 buffer, offset));
+      PACK_T *field_pack = PACK (m);
+      for (tree field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
+	{
+	  gcc_assert (COMPLETE_TYPE_P (TREE_TYPE (field)));
+	  //	  printf ("BYTE_POSITION\n");
+	  //	  debug_tree (byte_position (field));
+	  a68_add_stmt (fill_in_buffer (base, byte_position (field),
+					bounds, MOID (field_pack), allocator));
+	  FORWARD (field_pack);
+	}
+    }
+  else if (A68_UNION_TYPE_P (type))
+    {
+      /* Union values are initialized with an overhead of (sizetype) -1, which
+	 means it is not initialized.  Note that row declarers in united modes
+	 are formal declarers, so they never contribute bounds. */
+      tree overhead_address
+	= fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset);
+      tree uninitialized = fold_convert (sizetype, build_minus_one_cst (ssizetype));
+      a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node,
+				 fold_build1 (INDIRECT_REF, sizetype, overhead_address),
+				 uninitialized));
+#if 0
+      /* Set the rest of the union with zeroes.  */
+      tree value_address
+	= fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer),
+		       buffer,
+		       fold_build2 (PLUS_EXPR, sizetype, offset, size_in_bytes (sizetype)));
+
+      tree value_field = TREE_CHAIN (TYPE_FIELDS (type));
+      tree call = builtin_decl_explicit (BUILT_IN_MEMSET);
+      call = build_call_expr_loc (UNKNOWN_LOCATION, call, 3,
+				  value_address,
+				  integer_zero_node,
+				  size_in_bytes (TREE_TYPE (value_field)));
+      a68_add_stmt (call);
+#endif
+    }
+  else
+    gcc_unreachable ();
+
+  a68_add_stmt (buffer);
+  filler = a68_pop_stmt_list ();
+  TREE_TYPE (filler) = pointer_type;
+  return filler;
+}
+
+/* Lower to code that generates storage for a value of mode M, using bounds
+   from BOUNDS.  */
+
+static tree
+gen_mode (MOID_T *m, tree_stmt_iterator *bounds, allocator_t allocator)
+{
+  /* Allocate space for the value and fill it.  */
+  tree buffer = (*allocator) (CTYPE (m), size_in_bytes (CTYPE (m)));
+  buffer = save_expr (buffer);
+  return fill_in_buffer (buffer, size_zero_node, bounds, m, allocator);
+}
+
+/* Collect row bounds from BOUNDS.
+   Lower bounds are optional, and if not found they default to 1.  */
+
+static void
+collect_bounds (NODE_T *p, LOW_CTX_T ctx)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, BOUNDS_LIST))
+	collect_bounds (SUB (p), ctx);
+      else if (IS (p, BOUND))
+	collect_bounds (SUB (p), ctx);
+      else if (IS (p, UNIT))
+	{
+	  /* First the lower bound.  */
+	  tree lower_bound;
+	  if (NEXT (p) != NO_NODE && IS (NEXT (p), COLON_SYMBOL))
+	    {
+	      lower_bound = a68_lower_tree (p, ctx);
+	      p = NEXT_NEXT (p);
+	    }
+	  else
+	    /* Default lower bound.  */
+	    lower_bound = integer_one_node;
+
+	  /* Now the upper bound.  */
+	  tree upper_bound = a68_lower_tree (p, ctx);
+
+	  /* See the comment for collect_declarer_bounds for an explanation for
+	     the usage of save_expr here.  */
+	  a68_add_stmt (save_expr (lower_bound));
+	  a68_add_stmt (save_expr (upper_bound));
+	}
+    }
+}
+
+/* Append all the bounds found in the given declarer in the current statements
+   list.  */
+
+static void
+collect_declarer_bounds_1 (NODE_T *p, LOW_CTX_T ctx)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, BOUNDS))
+	collect_bounds (SUB (p), ctx);
+      else if (IS (p, INDICANT) && IS_LITERALLY (p, "STRING"))
+	return;
+      else if (IS (p, INDICANT))
+	{
+	  if (TAX (p) != NO_TAG && HAS_ROWS (MOID (TAX (p))))
+	    /* Continue from definition at MODE A = ....  */
+	    collect_declarer_bounds_1 (NEXT_NEXT (NODE (TAX (p))), ctx);
+	}
+      else if (IS (p, DECLARER)
+	       && (IS_UNION (MOID (p)) || !HAS_ROWS (MOID (p))))
+	  return;
+      else
+	collect_declarer_bounds_1 (SUB (p), ctx);
+    }
+}
+
+/* Given a declarer node, return a statements list with all the expressions of
+   the bounds within it.
+
+   Note that the language rules mandates that the bounds expression shall be
+   evaluated just once even when they are used by several generators, such as
+   in
+
+     [n +:= 1]real a, b;
+
+     Therefore the expressions are saved in save_exprs and the statements list
+     is cached in the CDECL field of the parse tree node.  */
+
+static tree
+collect_declarer_bounds (NODE_T *p, LOW_CTX_T ctx)
+{
+  if (CDECL (p) == NULL_TREE)
+    {
+      a68_push_stmt_list (M_VOID);
+      collect_declarer_bounds_1 (SUB (p), ctx);
+      CDECL (p) = a68_pop_stmt_list ();
+    }
+
+  return CDECL (p);
+}
+
+/* Low the elaboration of a generator.
+
+   The lowered code evaluates to a pointer.
+
+   DECLARER is the actual declarer passed to the generator.
+
+   MODE is the mode of the value to generate.
+
+   HEAP is true if we are lowering a heap generator, false if we are lowering a
+   LOC generator.  */
+
+tree
+a68_low_generator (NODE_T *declarer,
+		   MOID_T *mode,
+		   bool heap, LOW_CTX_T ctx)
+{
+  /* If the declarer is a mode indicant which has a recursive definition then
+     we need to lower to a function which gets immediately called rather than
+     an expression, to handle the recursivity.  In that case, though, we need
+     to always heap allocated memory for obvious reasons, which sucks, but such
+     is life.  */
+
+  if (IS (SUB (declarer), INDICANT) && TAX (SUB (declarer)) != NO_TAG
+      && IS_RECURSIVE (TAX (SUB (declarer))))
+    {
+      if (TAX_TREE_DECL (TAX (SUB (declarer))) != NULL_TREE)
+	{
+	  /* This is a recursive mode indicant.  Just call the function.  */
+	  return save_expr (build_call_expr_loc (a68_get_node_location (SUB (declarer)),
+						 TAX_TREE_DECL (TAX (SUB (declarer))),
+						 0));
+	}
+
+      tree ret_type = build_pointer_type (CTYPE (mode));
+      tree func_decl = build_decl (a68_get_node_location (declarer),
+				   FUNCTION_DECL,
+				   NULL_TREE /* name, set below */,
+				   build_function_type (ret_type, void_list_node));
+      char *name = xasprintf ("genroutine%d", DECL_UID (func_decl));
+      DECL_NAME (func_decl) = a68_get_mangled_identifier (name);
+      free (name);
+      DECL_EXTERNAL (func_decl) = 0;
+      DECL_STATIC_CHAIN (func_decl) = !a68_in_global_range ();
+      TREE_ADDRESSABLE (func_decl) = 1;
+      TREE_PUBLIC (func_decl) = a68_in_global_range ();
+      TREE_STATIC (func_decl) = 1;
+      TAX_TREE_DECL (TAX (SUB (declarer))) = func_decl;
+
+      a68_add_decl (func_decl);
+      a68_add_decl_expr (fold_build1_loc (a68_get_node_location (declarer),
+					  DECL_EXPR,
+					  TREE_TYPE (func_decl),
+					  func_decl));
+      announce_function (func_decl);
+      a68_push_function_range (func_decl, ret_type);
+
+      /* Collect bounds from declarer.  */
+      tree bounds = collect_declarer_bounds (declarer, ctx);
+
+      /* Allocate and initialize a memory buffer for a value of mode MODE with
+	 bounds in BOUNDS.  */
+      tree_stmt_iterator bounds_iter = tsi_start (bounds);
+      tree gen = gen_mode (mode, &bounds_iter, a68_lower_malloc);
+      a68_pop_function_range (gen);
+      /* Avoid this generator function, which uses the global lexical
+	 environment, to be reused in other contexts.  */
+      TAX_TREE_DECL (TAX (SUB (declarer))) = NULL_TREE;
+      return save_expr (build_call_expr_loc (a68_get_node_location (declarer),
+					     func_decl, 0));
+    }
+  else
+    {
+      /* Collect bounds from declarer.  */
+      tree bounds = collect_declarer_bounds (declarer, ctx);
+
+      /* Allocate and initialize a memory buffer for a value of mode MODE with
+	 bounds in BOUNDS.  */
+      tree_stmt_iterator bounds_iter = tsi_start (bounds);
+      tree gen = gen_mode (mode, &bounds_iter,
+			   heap ? a68_lower_malloc : a68_lower_alloca);
+      return gen;
+    }
+}
+
+/* Allocate storage for a value of mode M.
+   NBOUNDS is the number of bounds in BOUNDS.  */
+
+tree
+a68_low_gen (MOID_T *m, size_t nbounds, tree *bounds, bool use_heap)
+{
+  /* First collect bounds from BOUNDS into a statements list, which is what
+     gen_mode expects.  */
+  tree bounds_list = alloc_stmt_list ();
+  for (size_t i = 0; i < nbounds; ++i)
+    append_to_statement_list_force (bounds[i], &bounds_list);
+  allocator_t allocator = use_heap ? a68_lower_malloc : a68_lower_alloca;
+
+  tree_stmt_iterator q = tsi_start (bounds_list);
+  tree ret = gen_mode (m, &q, allocator);
+  free_stmt_list (bounds_list);
+  return ret;
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-ints.cc
@@ -0,0 +1,327 @@
+/* Lowering routines for all things related to INT values.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielind of SKIP for the given integral mode.  */
+
+tree
+a68_get_int_skip_tree (MOID_T *m)
+{
+  tree type;
+
+  if (m == M_INT)
+    type = a68_int_type;
+  else if (m == M_LONG_INT)
+    type = a68_long_int_type;
+  else if (m == M_LONG_LONG_INT)
+    type = a68_long_long_int_type;
+  else if (m == M_SHORT_INT)
+    type = a68_short_int_type;
+  else if (m == M_SHORT_SHORT_INT)
+    type = a68_short_short_int_type;
+  else
+    gcc_unreachable ();
+
+  return build_int_cst (type, 0);
+}
+
+/* Given an integral type, build the maximum value expressable in that
+   type.  */
+
+tree
+a68_int_maxval (tree type)
+{
+  return fold_convert (type, TYPE_MAX_VALUE (type));
+}
+
+/* Given an integral type, build the minimum value expressable in that
+   type.  */
+
+tree
+a68_int_minval (tree type)
+{
+  return fold_convert (type, TYPE_MIN_VALUE (type));
+}
+
+/* Given an integral type, build an INT with the number of decimal digits
+   required to represent a value of that typ, not including sign.  */
+
+tree
+a68_int_width (tree type)
+{
+  /* Note that log10 (2) is ~ 0.3.
+     Thanks to Andrew Pinski for suggesting using this expression.  */
+  return fold_build2 (PLUS_EXPR, a68_int_type,
+		      build_int_cst (a68_int_type, 1),
+		      fold_build2 (TRUNC_DIV_EXPR,
+				   a68_int_type,
+				   fold_build2 (MULT_EXPR, a68_int_type,
+						build_int_cst (a68_int_type, TYPE_PRECISION (type)),
+						build_int_cst (a68_int_type, 3)),
+				   build_int_cst (a68_int_type, 10)));
+}
+
+/* Given an integer value VAL, return -1 if it is less than zero, 0 if it is
+   zero and +1 if it is bigger than zero.  The built value is always of mode
+   M_INT.  */
+
+tree
+a68_int_sign (tree val)
+{
+  tree zero = build_int_cst (TREE_TYPE (val), 0);
+  return fold_build3 (COND_EXPR,
+		      a68_int_type,
+		      fold_build2 (EQ_EXPR, integer_type_node, val, zero),
+		      build_int_cst (a68_int_type, 0),
+		      fold_build3 (COND_EXPR,
+				   a68_int_type,
+				   fold_build2 (GT_EXPR, integer_type_node, val, zero),
+				   build_int_cst (a68_int_type, 1),
+				   build_int_cst (a68_int_type, -1)));
+}
+
+/* Absolute value of an integer.  */
+
+tree
+a68_int_abs (tree val)
+{
+  return fold_build1 (ABS_EXPR, TREE_TYPE (val), val);
+}
+
+/* Build the integral value lengthened from the value of VAL, from mode
+   FROM_MODE to mode TO_MODE.  */
+
+tree
+a68_int_leng (MOID_T *to_mode, MOID_T *from_mode ATTRIBUTE_UNUSED, tree val)
+{
+  /* Lengthening can be done by just a cast.  */
+  return fold_convert (CTYPE (to_mode), val);
+}
+
+/* Build the integral value that can be lengthened to the value of VAL, from
+   mode FROM_MODE to mode TO_MODE.
+
+   If VAL cannot be represented in TO_MODE because it is bigger than the most
+   positive value representable in TO_MODE, then it is truncated to that value.
+
+   Likewise, if VAL cannot be represented in TO_MODE because it is less than
+   the most negative value representable in TO_MODE, then it is truncated to
+   that value.  */
+
+tree
+a68_int_shorten (MOID_T *to_mode, MOID_T *from_mode ATTRIBUTE_UNUSED, tree val)
+{
+  tree most_positive_value = fold_convert (CTYPE (from_mode),
+					   a68_int_maxval (CTYPE (to_mode)));
+  tree most_negative_value = fold_convert (CTYPE (from_mode),
+					   a68_int_minval (CTYPE (to_mode)));
+
+  val = save_expr (val);
+  most_positive_value = save_expr (most_positive_value);
+  most_negative_value = save_expr (most_negative_value);
+  return fold_build3 (COND_EXPR, CTYPE (to_mode),
+		      fold_build2 (GT_EXPR, a68_bool_type, val, most_positive_value),
+		      fold_convert (CTYPE (to_mode), most_positive_value),
+		      fold_build3 (COND_EXPR, CTYPE (to_mode),
+				   fold_build2 (LT_EXPR, a68_bool_type, val, most_negative_value),
+				   fold_convert (CTYPE (to_mode), most_negative_value),
+				   fold_convert (CTYPE (to_mode), val)));
+}
+
+/* Given two integral values of mode M, build an expression that calculates the
+   addition of A and B.  */
+
+tree
+a68_int_plus (MOID_T *m, tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, PLUS_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates the
+   subtraction of A by B.  */
+
+tree
+a68_int_minus (MOID_T *m, tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, MINUS_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates the
+   multiplication of A by B.  */
+
+tree
+a68_int_mult (MOID_T *m, tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, MULT_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates the
+   division of A by B.  */
+
+tree
+a68_int_div (MOID_T *m, tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, TRUNC_DIV_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates
+   whether A = B.  */
+
+tree
+a68_int_eq (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates
+   whether A /= B.  */
+
+tree
+a68_int_ne (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates
+   whether A < B.  */
+
+tree
+a68_int_lt (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, LT_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates
+   whether A <= B.  */
+
+tree
+a68_int_le (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, LE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates
+   whether A > B.  */
+
+tree
+a68_int_gt (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, GT_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two integral values of mode M, build an expression that calculates
+   whether A >= B.  */
+
+tree
+a68_int_ge (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, GE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two integral values of mode M, build and expression that calculates the
+   modulus as specified by the Revised Report:
+
+   OP MOD = (L INT a, b) L INT:
+     (INT r = a - a % b * b; r < 0 | r + ABS b | r)
+*/
+
+tree
+a68_int_mod (MOID_T *m, tree a, tree b, location_t loc)
+{
+  a = save_expr (a);
+  b = save_expr (b);
+  tree r = a68_int_minus (m, a, a68_int_mult (m, a68_int_div (m, a, b), b));
+
+  r = save_expr (r);
+  return fold_build3_loc (loc, COND_EXPR, CTYPE (m),
+			  a68_int_lt (r, build_int_cst (CTYPE (m), 0)),
+			  a68_int_plus (m, r, a68_int_abs (b)),
+			  r);
+}
+
+/* Given two integral values values, the first of mode M an the second of mode
+   INT, build an expression that calculates the exponentiation of A by B, as
+   specified by the Revised Report:
+
+   OP ** = (L INT a, INT b) L INT:
+     (b >= 0 | L INT p := L 1; TO b DO p := p * a OD; p)
+*/
+
+tree
+a68_int_pow (MOID_T *m, tree a, tree b, location_t loc)
+{
+  tree zero = build_int_cst (CTYPE (m), 0);
+  tree one = build_int_cst (CTYPE (m), 1);
+
+  a = save_expr (a);
+  b = save_expr (fold_convert (CTYPE (m), b));
+
+  a68_push_range (m);
+  tree index = a68_lower_tmpvar ("index%", CTYPE (m), zero);
+  tree p = a68_lower_tmpvar ("p%", CTYPE (m), one);
+
+  /* Begin of loop body.  */
+  a68_push_range (NULL);
+  {
+    /* if (index == b) break;  */
+    a68_add_stmt (fold_build1 (EXIT_EXPR,
+			       void_type_node,
+			       fold_build2 (EQ_EXPR, CTYPE (m),
+					    index, b)));
+    a68_add_stmt (fold_build2 (MODIFY_EXPR, CTYPE (m),
+			       p, a68_int_mult (m, p, a)));
+
+    /* index++ */
+    a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, CTYPE (m),
+			       index, one));
+  }
+  tree loop_body = a68_pop_range ();
+  a68_add_stmt (fold_build1 (LOOP_EXPR,
+			     void_type_node,
+			     loop_body));
+  a68_add_stmt (p);
+  tree calculate_p = a68_pop_range ();
+  return fold_build3_loc (loc, COND_EXPR, CTYPE (m),
+			  a68_int_ge (b, zero),
+			  calculate_p, zero);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-misc.cc
@@ -0,0 +1,213 @@
+/* Lower miscellaneous tree nodes to GENERIC.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Lower an assertion.
+
+     assertion : assert symbol, enclosed clause.
+*/
+
+tree
+a68_lower_assertion (NODE_T *p, LOW_CTX_T ctx)
+{
+  if (!OPTION_ASSERT (&A68_JOB))
+    return a68_get_empty();
+
+  /* Build the call to the assert run-time function.  */
+  unsigned int lineno = NUMBER (LINE (INFO (p)));
+  const char *filename_str = FILENAME (LINE (INFO (p)));
+  tree filename = build_string_literal (strlen (filename_str) + 1,
+					filename_str);
+  tree call = a68_build_libcall (A68_LIBCALL_ASSERT,
+				 void_type_node, 2,
+				 filename,
+				 build_int_cst (unsigned_type_node, lineno));
+  /* Check condition and call assert if required.  */
+  tree assertion = fold_build2_loc (a68_get_node_location (p),
+				    COMPOUND_EXPR,
+				    a68_void_type,
+				    build2_loc (a68_get_node_location (p),
+						TRUTH_ORIF_EXPR,
+						a68_int_type,
+						a68_lower_tree (NEXT (SUB (p)), ctx),
+						fold_build2 (COMPOUND_EXPR,
+							     a68_int_type,
+							     call,
+							     build_int_cst (a68_int_type, 0))),
+				    a68_get_empty ());
+  TREE_SIDE_EFFECTS (assertion) = 1;
+  return assertion;
+}
+
+/* Lower a jump to a label.
+
+     jump : goto symbol, identifier;
+            identifier.
+
+   A jump lowers into a ({ GOTO_EXPR; EMPTY }).  */
+
+tree
+a68_lower_jump (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *label_identifier = SUB (p);
+  MOID_T *jump_mode = MOID (p);
+  if (!IS (label_identifier, IDENTIFIER))
+    FORWARD (label_identifier);
+
+  /* Create LABEL_DECL if necessary and chain it in both current block and bind
+     expression.  */
+  if (TAX_TREE_DECL (TAX (label_identifier)) == NULL_TREE)
+    {
+      tree label_decl = build_decl (a68_get_node_location (label_identifier),
+				    LABEL_DECL,
+				    a68_get_mangled_identifier (NSYMBOL (label_identifier)),
+				    void_type_node);
+      TAX_TREE_DECL (TAX (label_identifier)) = label_decl;
+    }
+
+  MOID (label_identifier) = M_VOID;
+  return fold_build2_loc (a68_get_node_location (p),
+			  COMPOUND_EXPR,
+			  CTYPE (jump_mode),
+			  fold_build1_loc (a68_get_node_location (p),
+					   GOTO_EXPR,
+					   void_type_node,
+					   a68_lower_tree (label_identifier, ctx)),
+			  a68_get_skip_tree (jump_mode));
+}
+
+/* Lower a parameter into a chain of PARAM_DECLs.
+
+     parameter : declarer, identifier;
+                 parameter, comma symbol, identifier.
+*/
+
+tree
+a68_lower_parameter (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree prev_parm_decls = NULL_TREE;
+  NODE_T *identifier = NO_NODE;
+  if (IS (SUB (p), PARAMETER))
+    {
+      prev_parm_decls = a68_lower_tree (SUB (p), ctx);
+      identifier = NEXT (NEXT (SUB (p)));
+    }
+  else
+    identifier = NEXT (SUB (p));
+
+  /* Create the PARM_DECL.  */
+  tree parm_decl = build_decl (a68_get_node_location (p),
+			       PARM_DECL,
+			       a68_get_mangled_identifier (NSYMBOL (identifier)),
+			       CTYPE (MOID (identifier)));
+  DECL_CONTEXT (parm_decl) = current_function_decl;
+  DECL_ARG_TYPE (parm_decl) = TREE_TYPE (parm_decl);
+  TAX_TREE_DECL (TAX (identifier)) = parm_decl;
+
+  layout_decl (parm_decl, 0);
+
+  if (prev_parm_decls != NULL)
+    return chainon (prev_parm_decls, parm_decl);
+  else
+    return parm_decl;
+}
+
+/* Lower a list of parameters into a chain of PARAM_DECLs.
+
+        parameter list : parameter;
+                         parameter list; comma symbol; parameter.
+*/
+
+tree
+a68_lower_parameter_list (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree parm_decl = NULL_TREE;
+  tree prev_parm_decls = NULL_TREE;
+  if (IS (SUB (p), PARAMETER_LIST))
+    {
+      prev_parm_decls = a68_lower_tree (SUB (p), ctx);
+      parm_decl = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+    }
+  else
+    parm_decl = a68_lower_tree (SUB (p), ctx);
+
+  gcc_assert (parm_decl != NULL_TREE);
+  if (prev_parm_decls != NULL)
+    return chainon (prev_parm_decls, parm_decl);
+  else
+    return parm_decl;
+}
+
+/* Lower a parameter pack into a chain of PARAM_DECLs.
+
+     parameter pack : open symbol, parameter list, close symbol.
+*/
+
+tree
+a68_lower_parameter_pack (NODE_T *p, LOW_CTX_T ctx)
+{
+  /* Lower the contained PARAMETER_LIST.  */
+  return a68_lower_tree (NEXT (SUB (p)), ctx);
+}
+
+/* Lower an applied operator.
+
+   Applied operators lower into a function object that gets one argument in
+   case of monadic operators, or two arguments in case of dyadic operators.  */
+
+tree
+a68_lower_operator (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  /* This is an user defined operator.  Handle it in a similar way than applied
+     identifiers.  */
+  tree func_decl = TAX_TREE_DECL (TAX (p));
+  if (func_decl == NULL_TREE)
+    {
+      if (IN_PROC (TAX (p)))
+	func_decl = a68_make_proc_identity_declaration_decl (p);
+      else
+	func_decl = a68_make_identity_declaration_decl (p);
+      TAX_TREE_DECL (TAX (p)) = func_decl;
+    }
+  return func_decl;
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-moids.cc
@@ -0,0 +1,716 @@
+/* Lower Algol 68 modes to GCC trees.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "stringpool.h"
+#include "tree.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "print-tree.h"
+
+#include "a68.h"
+
+static tree a68_lower_mode (MOID_T *m);
+
+/*
+ * Support routines and definitions.
+ */
+
+/* Build a stub TYPE_DECL for a given TYPE.
+
+   This is used for TYPE_STUB_DECL so we can generate debug info for all our
+   modes, so the TYPE_DECL has no name.  */
+
+static void
+build_stub_type_decl (tree type, tree context)
+{
+  if (TYPE_STUB_DECL (type))
+    return;
+
+  tree decl = build_decl (UNKNOWN_LOCATION,
+			  TYPE_DECL,
+			  NULL_TREE /* name */,
+			  type);
+  TREE_PUBLIC (decl) = 1;
+  DECL_CONTEXT (decl) = context;
+  TYPE_CONTEXT (type) = DECL_CONTEXT (decl);
+  TYPE_NAME (type) = decl; /* Weird.  This is for typedefs! */
+  TYPE_STUB_DECL (type) = decl;
+}
+
+/* Builds a record type whose name is NAME.  NFIELDS is the number of fields,
+   provided as field ident/type pairs.
+
+   This code is copied from the D front end.  */
+
+static tree
+make_struct_type (tree type, const char *name, int nfields, ...)
+{
+  tree fields = NULL_TREE;
+  va_list ap;
+
+  va_start (ap, nfields);
+
+  for (int i = 0; i < nfields; i++)
+    {
+      tree ident = va_arg (ap, tree);
+      tree type = va_arg (ap, tree);
+      tree field = build_decl (BUILTINS_LOCATION, FIELD_DECL, ident, type);
+      DECL_CHAIN (field) = fields;
+      fields = field;
+    }
+
+  va_end (ap);
+
+  if (type == NULL_TREE)
+    type = make_node (RECORD_TYPE);
+  finish_builtin_struct (type, name, fields, NULL_TREE);
+
+  return type;
+}
+
+/* Iterate over all the field selectors FIELDS of a structure type and add them
+   as fields to CONTEXT.  Returns the number of field selectors found.  */
+
+static size_t
+chain_struct_fields (PACK_T *fields, tree context)
+{
+  PACK_T *elem;
+  size_t num_fields;
+
+  for (num_fields = 0, elem = fields;
+       elem != NO_PACK;
+       FORWARD (elem), ++num_fields)
+    {
+      const char *field_name = TEXT (elem);
+      MOID_T *field_mode = MOID (elem);
+      tree field_type = a68_lower_mode (field_mode);
+
+      /* Create the field declaration.
+         The declaration is not a compiler-generated entity.
+	 Do not ignore the declaration for symbolic debug purposes. */
+      tree field_decl = build_decl ((NODE (field_mode)
+				     ? a68_get_node_location (NODE (field_mode))
+				     : UNKNOWN_LOCATION),
+				    FIELD_DECL,
+				    field_name ? get_identifier (field_name) : NULL_TREE,
+				    field_type);
+      DECL_ARTIFICIAL (field_decl) = 0;
+      DECL_IGNORED_P (field_decl) = 0;
+
+      /* If the mode of the field is not a ref then references to the field
+	 cannot appear in a LHS of an assignment.  */
+      TREE_READONLY (field_decl) = IS_REF (field_mode);
+
+      /* Associate the tree field declaration and the front end node.  */
+      DECL_LANG_SPECIFIC (field_decl) =
+	(NODE (field_mode) ? a68_build_lang_decl (NODE (field_mode)) : NULL);
+
+      /* Chain the field declaration in its containing context.  */
+      DECL_FIELD_CONTEXT (field_decl) = context;
+      TYPE_FIELDS (context) = chainon (TYPE_FIELDS (context), field_decl);
+    }
+
+  return num_fields;
+}
+
+/* If the union or struct type TYPE completes the type of any previous field
+   declarations, lay them out now.  */
+
+static void
+finish_incomplete_fields (tree type)
+{
+  for (tree fwdref = TYPE_FORWARD_REFERENCES (type); fwdref != NULL_TREE;
+       fwdref = TREE_CHAIN (fwdref))
+    {
+      tree field = TREE_VALUE (fwdref);
+      tree struct_or_union_type = DECL_FIELD_CONTEXT (field);
+
+      relayout_decl (field);
+      bool type_complete = true;
+      for (tree field = TYPE_FIELDS (struct_or_union_type);
+	   field;
+	   field = DECL_CHAIN (field))
+	{
+	  if (!COMPLETE_TYPE_P (TREE_TYPE (field)))
+	    {
+	      type_complete = false;
+	      break;
+	    }
+	}
+
+      if (type_complete)
+	{
+	  // XXX why this fires
+	  //	  gcc_assert (!COMPLETE_TYPE_P (struct_or_union_type));
+	  layout_type (struct_or_union_type);
+	  /* Set the back-end type mode now that all fields have had their size
+	     set.  */
+	  compute_record_mode (struct_or_union_type);
+	}
+    };
+
+  /* No more forward references to process.  */
+  TYPE_FORWARD_REFERENCES (type) = NULL_TREE;
+}
+
+/*
+ * Mode lowering routines.
+ */
+
+/* Lower a HIP mode to a GENERIC tree.
+   HIP is the mode of NIL.  */
+
+static tree
+lower_hip_mode (MOID_T *m)
+{
+  static tree hip_type;
+
+  if (hip_type == NULL)
+    {
+      hip_type = build_pointer_type (a68_void_type);
+      TYPE_LANG_SPECIFIC (hip_type) = a68_build_lang_type (m);
+      CTYPE (m) = hip_type;
+    }
+
+  return hip_type;
+}
+
+/* Lower a standard mode to a GENERIC tree.
+
+   Note that this function only has to handle the standard modes that have not
+   been resolved to some equivalent.  */
+
+static tree
+lower_standard_mode (MOID_T *m)
+{
+  tree type = NULL_TREE;
+
+  if (m == M_VOID)
+    type = a68_void_type;
+  else if (m == M_BOOL)
+    type = a68_bool_type;
+  else if (m == M_CHAR)
+    type = a68_char_type;
+  else if (m == M_SHORT_SHORT_INT)
+    type = a68_short_short_int_type;
+  else if (m == M_SHORT_INT)
+    type = a68_short_int_type;
+  else if (m == M_INT)
+    type = a68_int_type;
+  else if (m == M_LONG_INT)
+    type = a68_long_int_type;
+  else if (m == M_LONG_LONG_INT)
+    type = a68_long_long_int_type;
+  else if (m == M_REAL)
+    type = a68_real_type;
+  else if (m == M_LONG_REAL)
+    type = a68_long_real_type;
+  else if (m == M_LONG_LONG_REAL)
+    type = a68_long_long_real_type;
+  else if (m == M_SHORT_SHORT_BITS)
+    type = a68_short_short_bits_type;
+  else if (m == M_SHORT_BITS)
+    type = a68_short_bits_type;
+  else if (m == M_BITS)
+    type = a68_bits_type;
+  else if (m == M_LONG_BITS)
+    type = a68_long_bits_type;
+  else if (m == M_LONG_LONG_BITS)
+    type = a68_long_long_bits_type;
+  else if (m == M_BYTES)
+    type = a68_bytes_type;
+  else if (m == M_LONG_BYTES)
+    type = a68_long_bytes_type;
+  else if (m == M_FILE)
+    /* XXX for now this is a file descriptor.  */
+    type = integer_type_node;
+  else if (m == M_CHANNEL)
+    /* XXX for now this is a channel descriptor.  */
+    type = integer_type_node;
+  else
+    gcc_unreachable ();
+
+  TYPE_LANG_SPECIFIC (type) = a68_build_lang_type (m);
+  return type;
+}
+
+/* Lower a struct mode to a GENERIC tree.  */
+
+static tree
+lower_struct_mode (MOID_T *m)
+{
+  /* First make the GENERIC struct.  This is needed in case of
+     self-references.  */
+  tree struct_type = make_node (RECORD_TYPE);
+  TYPE_NAME (struct_type) = get_identifier ("lalastruct%");
+  TYPE_FIELDS (struct_type) = NULL_TREE;
+  TYPE_CXX_ODR_P (struct_type) = 0;
+  CTYPE (m) = struct_type;
+  TYPE_LANG_SPECIFIC (struct_type) = a68_build_lang_type (m); /* XXX this will get overrided. */
+
+  /* Add field declarations.  */
+  chain_struct_fields (PACK (m), struct_type);
+
+  /* Layout all fields.  */
+  bool struct_type_complete = true;
+  for (tree field = TYPE_FIELDS (struct_type); field; field = DECL_CHAIN (field))
+    {
+      tree basetype = TREE_TYPE (field);
+
+      if (!COMPLETE_TYPE_P (basetype))
+	{
+	  tree field_type = TREE_TYPE (field);
+	  tree forward_refs = tree_cons (NULL_TREE, field,
+					 TYPE_FORWARD_REFERENCES (field_type));
+	  TYPE_FORWARD_REFERENCES (struct_type) = forward_refs;
+
+	  struct_type_complete = false;
+	  continue;
+	}
+
+      layout_decl (field, 0);
+      gcc_assert (DECL_SIZE (field) != NULL_TREE);
+    }
+
+  /* If all fields have complete types then we can layout the struct type now.
+     Otherwise it will be done in finish_incomplete_types.  */
+  if (struct_type_complete)
+    {
+      layout_type (struct_type);
+      /* Set the back-end type mode now that all fields have had their size
+	 set.  */
+      compute_record_mode (struct_type);
+    }
+
+  /* Finish debugging output for this type.  */
+  build_stub_type_decl (struct_type, NULL_TREE /* context */);
+  rest_of_type_compilation (struct_type, TYPE_FILE_SCOPE_P (struct_type));
+  rest_of_decl_compilation (TYPE_NAME (struct_type), 1 /* file scope p */, 0);
+  A68_STRUCT_TYPE_P (struct_type) = 1;
+  return struct_type;
+}
+
+/* Lower a ref mode to a GENERIC tree.
+   REF AMODE lowers to a pointer.  */
+
+static tree
+lower_ref_mode (MOID_T *m)
+{
+  return build_pointer_type (a68_lower_mode (SUB (m)));
+}
+
+/* Lower a flex mode to a GENERIC tree.  */
+
+static tree
+lower_flex_mode (MOID_T *m)
+{
+  /* This is basically a qualifier of the parent REF.  */
+  return a68_lower_mode (SUB (m));
+}
+
+/* Lower a proc mode to a GENERIC tree.  */
+
+static tree
+lower_proc_mode (MOID_T *m)
+{
+  tree fnargs = NULL_TREE;
+  tree ret_type;
+
+  /* We have to create the function type in advance because it can appear
+     recursively as the type of arguments and/or of the return value.  We
+     cannot use build_function_type, as it doesn't support recursive types.  */
+  tree function_type = make_node (FUNCTION_TYPE);
+  tree ptr_function_type = build_pointer_type (function_type);
+  CTYPE (m) = ptr_function_type;
+
+  /* Now add arguments and return value types.  */
+  for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p))
+    {
+      tree arg_type = a68_lower_mode (MOID (p));
+      fnargs = chainon (fnargs, build_tree_list (0, arg_type));
+    }
+  ret_type = a68_lower_mode (SUB (m));
+
+  /* Complete the function type.  Note that there is some code duplication with
+     build_function_type, which we cannot use, but such is life.  */
+  TREE_TYPE (function_type) = ret_type; /* THIS */
+  TYPE_ARG_TYPES (function_type) = fnargs;
+  SET_TYPE_STRUCTURAL_EQUALITY (function_type);
+
+  if (!COMPLETE_TYPE_P (function_type))
+    layout_type (function_type);
+
+  return ptr_function_type;
+}
+
+/* Lower an union mode to a GENERIC tree.
+
+   overhead%     Characterizes the actual mode of the value.
+   value%        GENERIC union.  */
+
+static tree
+lower_union_mode (MOID_T *m)
+{
+  // XXX make the union type QUAL_UNION_TYPE and relate the fields with the
+  // overhead%.  This is necessary for DWARF.
+  tree union_type = make_node (RECORD_TYPE);
+  TYPE_NAME (union_type) = NULL_TREE;
+  TYPE_FIELDS (union_type) = NULL_TREE;
+  TYPE_CXX_ODR_P (union_type) = 0;
+  CTYPE (m) = union_type;
+
+  /* Then the GENERIC union.  */
+  tree c_union_type = make_node (UNION_TYPE);
+  TYPE_NAME (c_union_type) = NULL_TREE;
+  TYPE_FIELDS (c_union_type) = NULL_TREE;
+  TYPE_CXX_ODR_P (c_union_type) = 0; // XXX otherwise lto complains.  why.
+  SET_TYPE_STRUCTURAL_EQUALITY (c_union_type);
+
+  /* Add field declarations.  */
+  chain_struct_fields (PACK (m), c_union_type);
+
+  /* Layout all fields now the type is complete.  */
+  bool c_union_type_complete = true;
+  for (tree field = TYPE_FIELDS (c_union_type); field; field = DECL_CHAIN (field))
+    {
+      tree field_type = TREE_TYPE (field);
+
+      if (!COMPLETE_TYPE_P (field_type))
+	{
+	  tree field_type = TREE_TYPE (field);
+	  tree forward_refs = tree_cons (NULL_TREE, field,
+					 TYPE_FORWARD_REFERENCES (field_type));
+	  TYPE_FORWARD_REFERENCES (c_union_type) = forward_refs;
+
+	  c_union_type_complete = false;
+	  continue;
+	}
+
+      layout_decl (field, 0);
+      gcc_assert (DECL_SIZE (field) != NULL_TREE);
+    }
+
+  /* If all fields have complete types then we can layout the c-union type now.
+     Otherwise it will be done in finish_incomplete_types.  */
+  if (c_union_type_complete)
+    {
+      layout_type (c_union_type);
+      /* Set the back-end type mode now that all fields have had their size
+	 set.  */
+      compute_record_mode (c_union_type);
+    }
+
+  /* Finish debugging output for this type.  */
+  build_stub_type_decl (c_union_type, NULL_TREE /* context */);
+  rest_of_type_compilation (c_union_type, TYPE_FILE_SCOPE_P (c_union_type));
+  rest_of_decl_compilation (TYPE_NAME (c_union_type), 1 /* file scope p */, 0);
+
+  /* Now the type with the overhead.  */
+  TYPE_NAME (union_type) = get_identifier ("union%");
+  tree overhead_field = build_decl (UNKNOWN_LOCATION, FIELD_DECL,
+				    get_identifier ("overhead%"), sizetype);
+  tree value_field = build_decl (UNKNOWN_LOCATION, FIELD_DECL,
+				 get_identifier ("value%"), c_union_type);
+  DECL_FIELD_CONTEXT (overhead_field) = union_type;
+  DECL_FIELD_CONTEXT (value_field) = union_type;
+  DECL_CHAIN (value_field) = NULL_TREE;
+  DECL_CHAIN (overhead_field) = value_field;
+  TYPE_FIELDS (union_type) = overhead_field;
+
+  if (c_union_type_complete)
+    {
+      layout_type (union_type);
+      /* Set the back-end type mode now that all fields have had their size
+	 set.  */
+      compute_record_mode (union_type);
+    }
+  else
+    {
+      tree forward_refs = tree_cons (NULL_TREE, value_field,
+				     TYPE_FORWARD_REFERENCES (union_type));
+      TYPE_FORWARD_REFERENCES (union_type) = forward_refs;
+    }
+
+  SET_TYPE_STRUCTURAL_EQUALITY (union_type);
+  A68_UNION_TYPE_P (union_type) = 1;
+  return union_type;
+}
+
+/* Return the type for an array descriptor triplet.  */
+
+tree
+a68_triplet_type (void)
+{
+  static tree triplet_type = NULL_TREE;
+  if (triplet_type == NULL_TREE)
+    {
+      triplet_type = make_struct_type (NULL_TREE, "triplet%", 3,
+				       get_identifier ("lb%"),
+				       ssizetype,
+				       get_identifier ("ub%"),
+				       ssizetype,
+				       get_identifier ("stride%"),
+				       sizetype);
+    }
+
+  return triplet_type;
+}
+
+/* Return the lower bound field in an array descriptor triplet.  */
+
+tree
+a68_triplet_type_lower_bound (tree triplet)
+{
+  tree lb_field = TYPE_FIELDS (triplet);
+  return lb_field;
+}
+
+/* Lower a row mode to a GENERIC tree.
+
+   descriptor%
+     triplets%     Value of ARRAY_TYPE with an entry per multiple dimension.
+     {
+       li%         Lower bound of dimension.
+       ui%         Upper bound of dimension.
+       di%         Stride of dimension in bytes.
+     }
+   elements%       Pointer to the elements.
+   elements_size%  Size of elements% in bytes.
+*/
+
+static tree
+lower_row_mode (MOID_T *m)
+{
+  int num_dimensions = DIM (m);
+  tree triplet_type = a68_triplet_type ();
+  tree triplets_type = build_array_type (triplet_type,
+					 build_index_type (size_int (num_dimensions - 1)));
+  tree element_type = a68_lower_mode (SUB (m));
+  tree row_type = make_struct_type (NULL_TREE, "row%", 3,
+				    get_identifier ("triplets%"),
+				    triplets_type,
+				    get_identifier ("elements%"),
+				    build_pointer_type (element_type),
+				    get_identifier ("elements_size%"),
+				    sizetype);
+  layout_type (row_type);
+  A68_ROW_TYPE_P (row_type) = 1;
+  return row_type;
+}
+
+/* Given a row type, return the type of the pointer to its elements.  */
+
+tree
+a68_row_elements_pointer_type (tree type)
+{
+  gcc_assert (A68_ROW_TYPE_P (type));
+  /* elements% is the second field.  */
+  return TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)));
+}
+
+/* Given a row type, return the type of its elements.  */
+
+tree
+a68_row_elements_type (tree type)
+{
+  return TREE_TYPE (a68_row_elements_pointer_type (type));
+}
+
+/* Lower a ROWS mode to a GENERIC tree.
+
+   dim%         Number of dimensions.
+   triplets%    Pointer to triplets.
+
+   Values of this mode are passed to the operators UPB, LWB and ELEMS, which
+   need only descriptor information.  There is no need to store any multiple
+   elements.  */
+
+static tree
+lower_rows_mode (MOID_T *m ATTRIBUTE_UNUSED)
+{
+  static tree rows_type = NULL_TREE;
+
+  if (rows_type == NULL_TREE)
+    {
+      rows_type = make_struct_type (NULL_TREE, "rows%", 2,
+				    get_identifier ("dim%"),
+				    sizetype,
+				    get_identifier ("triplets%"),
+				    build_pointer_type (a68_triplet_type ()));
+      A68_ROWS_TYPE_P (rows_type) = 1;
+    }
+  return rows_type;
+}
+
+/* Lower modes in a series.  This is used as the mode of the mode yielded by an
+   enclosed clause that yields a series of united rows, for M_ROWS.  */
+
+static tree
+lower_series (MOID_T *m)
+{
+  for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p))
+    {
+      if (IS (MOID (p), SERIES_MODE) || IS (MOID (p), STOWED_MODE))
+	lower_series (MOID (p));
+      else
+	(void) a68_lower_mode (MOID (p));
+    }
+
+  return lower_rows_mode (NO_MOID);
+}
+
+/* Lower a mode to a GENERIC tree.  */
+
+static tree
+a68_lower_mode (MOID_T *m)
+{
+  tree type = NULL_TREE;
+
+  /* If the given mode has already been lowered, return the corresponding
+     tree.  */
+  if (CTYPE (m) != NULL)
+    return CTYPE (m);
+
+  if (EQUIVALENT (m) != NO_MOID && EQUIVALENT (m) != m)
+    /* This covers INDICANTs and standard MOIDS having an equivalent mode.  */
+    type = a68_lower_mode (EQUIVALENT (m));
+  else if (m == M_VOID)
+    type = a68_void_type;
+  else if (m == M_HIP)
+    type = lower_hip_mode (m);
+  else if (IS (m, STANDARD))
+    type = lower_standard_mode (m);
+  else if (IS_REF (m))
+    type = lower_ref_mode (m);
+  else if (IS_FLEX (m))
+    type = lower_flex_mode (m);
+  else if (IS (m, PROC_SYMBOL))
+    type = lower_proc_mode (m);
+  else if (IS_STRUCT (m))
+    type = lower_struct_mode (m);
+  else if (IS_ROW (m))
+    type = lower_row_mode (m);
+  else if (IS_UNION (m))
+    type = lower_union_mode (m);
+  else if (m == M_SIMPLOUT || m == M_SIMPLIN)
+    type = a68_void_type;
+  else if (IS (m, ROWS_SYMBOL))
+    /* ROWS is a mode that means "any row mode".  */
+    type = lower_rows_mode (m);
+  else if (m == M_VACUUM)
+    /* This is a mode that should not survive the parser.  */
+    type = a68_void_type;
+  else if (IS (m, SERIES_MODE) || IS (m, STOWED_MODE))
+    {
+      /* When dealing with operators the parser creates some modes that leak
+	 SERIES and STOWED "proto-modes" in them, such as for example:
+
+	 UNION ((INT, INT), INT, PROC [] CHAR)
+
+	 These are not really real Algol 68 modes and are useless by
+	 themselves, so when we find them, we traverse them (they ultimately
+	 contain valid modes that may show up in other contexts and that
+	 require being lowered) and just report them as VOID.  */
+      type = lower_series (m);
+    }
+  else
+    {
+      fatal_error (NODE (m) ? a68_get_node_location (NODE (m)) : UNKNOWN_LOCATION,
+		   "Cannot lower mode %s",
+		   a68_moid_to_string (m, MOID_ERROR_WIDTH, NODE (m)));
+    }
+
+  /* Associate the created tree node with the mode, and vice-versa.  */
+  gcc_assert (type != NULL_TREE);
+  TYPE_LANG_SPECIFIC (type) = a68_build_lang_type (m);
+  A68_TYPE_HAS_ROWS_P (type) = HAS_ROWS (m);
+  if (CTYPE (m) == NULL_TREE)
+    CTYPE (m) = type;
+  //  printf ("DONE LOWERING %s\n", a68_moid_to_string (m, MOID_ERROR_WIDTH, NODE (m)));
+  return type;
+}
+
+/* Lower MOIDs to GENERIC trees.  */
+
+void
+a68_lower_moids (MOID_T *mode)
+{
+  /* First pass: all modes but refs.  */
+  for (MOID_T *m = mode; m != NO_MOID; FORWARD (m))
+    (void) a68_lower_mode (m);
+
+  /* Try to layout all incomplete types.  This is a two-passes process.  */
+
+  for (MOID_T *m = mode; m != NO_MOID; FORWARD (m))
+    {
+      if (IS_STRUCT (m))
+	{
+	  tree struct_type = CTYPE (m);
+	  finish_incomplete_fields (struct_type);
+	}
+      else if (IS_UNION (m))
+	{
+	  tree union_type = CTYPE (m);
+	  tree c_union_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (union_type)));
+	  finish_incomplete_fields (c_union_type);
+	  finish_incomplete_fields (union_type);
+	}
+    }
+
+  for (MOID_T *m = mode; m != NO_MOID; FORWARD (m))
+    {
+      if (!COMPLETE_TYPE_P (CTYPE (m)))
+	{
+	  if (IS_STRUCT (m))
+	    {
+	      tree struct_type = CTYPE (m);
+	      compute_record_mode (struct_type);
+	    }
+	  else if (IS_UNION (m))
+	    {
+	      tree union_type = CTYPE (m);
+	      tree c_union_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (union_type)));
+
+	      if (!COMPLETE_TYPE_P (c_union_type))
+		{
+		  layout_type (c_union_type);
+		  compute_record_mode (c_union_type);
+		}
+
+	      layout_type (union_type);
+	      compute_record_mode (union_type);
+	    }
+	  else
+	    layout_type (CTYPE (m));
+	}
+    }
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-multiples.cc
@@ -0,0 +1,1097 @@
+/* Lowering routines for all things related to multiples.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Algol 68 multiples are multi-dimensional and dynamically sized. They have a
+   static part and a dynamic part.  The static part is conformed by a
+   "descriptor", which contains information about each of the dimensions, and a
+   pointer to the actual elements stored in the multiple.  The dynamic part are
+   the elements, which are stored in column order.  Both the descriptor and the
+   elements may reside on the stack, data section, or the heap.  The mode of a
+   multiple is a "row".
+
+   Schematically, the descriptor contains:
+
+      triplets%
+        lb% ub% stride%
+	...
+      elements%
+      elements_size%
+
+   Where elements_size% is the size of the buffer pointed by elements%, in
+   bytes.
+
+   There is a triplet per dimension in the multiple.  The number of dimensions
+   in a row mode is static and is determined at compile-time.
+
+   The infomation stored for each triplet is:
+
+     lb%     is the lower bound of the dimension.
+     ub%     is the upper bound of the dimension.
+     stride% is the stride of the dimension.
+
+   The stride of each dimension is the number of bytes to skip in order to
+   access the next element in that dimension.  They express the layout of the
+   multiple in memory.
+
+   Algol 68 multi-dimensional multiples are stored in row-major (generalized,
+   lexicographical) order:
+
+     [1:3,1:2]AMODE = ((e1, e2, e3),
+                       (e4, e5, e6))
+
+   is stored as:
+
+          1  2  3
+       1  e1 e2 e3      | stride 2S ->  stride 1S
+       2  e4 e5 e6      v
+
+   Where S is the size in bytes of a single element.  That means that for two
+   dimensional multiples, the column stride is always 1S and the row stride is
+   the column size.
+
+   In general, given a mode with number of elements N1, N2, N3, ...:
+
+     [N1,N2,N3...,Nn]AMODE
+
+   the strides of the dimensions are:
+
+     S1 = N2 * S2
+     S2 = N3 * S3
+     S3 = N4 * S4
+     ...
+     Si = N1 * N2 * ... * Ni-1
+
+   Indexing is then performed by a dot-product of an element coordinate and the
+   strides:
+
+     (i1,i2,i3) . (S1,S2,S3) = offset + i1*S1 + i2*S2 + i3*S3 = index in elements array.
+
+   Note that the number of elements in each dimension can be easily derived
+   from the bounds and there is no need to store them explicitly, save for
+   performance reasons.  Descriptors are bulky enough and often they they are
+   stored on the stack, so we prefer to pay in performance and save in
+   storage.  */
+
+/* Return a tree with the yielding of SKIP for the given row mode, a
+   multiple.  */
+
+tree
+a68_get_multiple_skip_tree (MOID_T *m)
+{
+  tree res = NULL_TREE;
+  int dim = DIM (m);
+  tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * dim);
+  tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * dim);
+  tree ssize_one_node = fold_convert (ssizetype, size_one_node);
+  tree ssize_zero_node = fold_convert (ssizetype, size_zero_node);
+  for (int i = 0; i < dim; ++i)
+    {
+      lower_bounds[i] = ssize_one_node;
+      upper_bounds[i] = ssize_zero_node;
+    }
+  res = a68_row_value (CTYPE (m), dim,
+		       build_int_cst (build_pointer_type (void_type_node), 0),
+		       size_zero_node, /* elements_size */
+		       lower_bounds, upper_bounds);
+  free (lower_bounds);
+  free (upper_bounds);
+  return res;
+}
+
+/* Return the number of dimensions of the multiple EXP as an integer
+   constant.  */
+
+tree
+a68_multiple_dimensions (tree exp)
+{
+  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));
+
+  /* triplets% is the first field in the descriptor.  */
+  tree triplets_field = TYPE_FIELDS (TREE_TYPE (exp));
+  return array_type_nelts_top (TREE_TYPE (triplets_field));
+}
+
+/* Return an expression that evaluates to the total number of elements stored
+   in a multiple as a sizetype.  */
+
+tree
+a68_multiple_num_elems (tree exp)
+{
+  /* We have to calculate the number of elements based on the dimension
+     triplets in the array type.  The number of dimensions is known at compile
+     time, so we don't really need a loop.  */
+
+  tree num_dimensions_tree = a68_multiple_dimensions (exp);
+  gcc_assert (TREE_CODE (num_dimensions_tree) == INTEGER_CST);
+  int num_dimensions = tree_to_shwi (num_dimensions_tree);
+
+  tree size = NULL_TREE;
+  for (int dim = 0; dim < num_dimensions; ++dim)
+    {
+      tree size_dim = size_int (dim);
+      tree lower_bound = a68_multiple_lower_bound (exp, size_dim);
+      tree upper_bound = a68_multiple_upper_bound (exp, size_dim);
+      tree dim_size = fold_build2 (PLUS_EXPR, sizetype,
+				   fold_convert (sizetype, fold_build2 (MINUS_EXPR,
+									ssizetype,
+									upper_bound,
+									lower_bound)),
+				   size_one_node);
+
+      if (size == NULL_TREE)
+	size = dim_size;
+      else
+	size = fold_build2 (MULT_EXPR, sizetype, size, dim_size);
+    }
+
+  return size;
+}
+
+/* Return a size expression that evaluates to the total size, in bytes, of the
+   elements stored in the multiple.  */
+
+tree
+a68_multiple_elements_size (tree exp)
+{
+  tree type = TREE_TYPE (exp);
+  gcc_assert (A68_ROW_TYPE_P (type));
+
+  /* elements_size% is the third field in the descriptor.  */
+  tree elements_size_field = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (type)));
+  return fold_build3 (COMPONENT_REF, TREE_TYPE (elements_size_field),
+		      exp, elements_size_field, NULL_TREE);
+}
+
+/* Return the triplet for dimension DIM in the multiple EXP.  */
+
+static tree
+multiple_triplet (tree exp, tree dim)
+{
+  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));
+
+  /* triplets% is the first field in the descriptor.  */
+  tree triplets_field = TYPE_FIELDS (TREE_TYPE (exp));
+  tree triplets = fold_build3 (COMPONENT_REF,
+			       TREE_TYPE (triplets_field),
+			       exp,
+			       triplets_field,
+			       NULL_TREE);
+
+  /* Get the triplet for the given dimension.  */
+  return build4 (ARRAY_REF,
+		 TREE_TYPE (TREE_TYPE (triplets)),
+		 triplets,
+		 dim,
+		 NULL_TREE,
+		 NULL_TREE);
+}
+
+/* Return the lower bound of dimension DIM of the multiple EXP.  The returned
+   value is a ssizetype.  */
+
+tree
+a68_multiple_lower_bound (tree exp, tree dim)
+{
+  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));
+
+  /* lb% is the first field in the triplet.  */
+  tree triplet = multiple_triplet (exp, dim);
+  tree lower_bound_field = TYPE_FIELDS (TREE_TYPE (triplet));
+  return fold_build3 (COMPONENT_REF,
+		      TREE_TYPE (lower_bound_field),
+		      triplet,
+		      lower_bound_field,
+		      NULL_TREE);
+}
+
+/* Return an expression that sets the lower bound of dimension DIM of the
+   multiple EXP to BOUND.  */
+
+tree
+a68_multiple_set_lower_bound (tree exp, tree dim, tree bound)
+{
+  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));
+  return fold_build2 (MODIFY_EXPR,
+		      TREE_TYPE (bound),
+		      a68_multiple_lower_bound (exp, dim),
+		      bound);
+}
+
+/* Return the upper bound of dimension DIM of the multiple EXP.  The returned
+   value is a ssizetype.  */
+
+tree
+a68_multiple_upper_bound (tree exp, tree dim)
+{
+  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));
+
+  /* ub% is the second field in the triplet.  */
+  tree triplet = multiple_triplet (exp, dim);
+  tree upper_bound_field = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (triplet)));
+  return fold_build3 (COMPONENT_REF,
+		      TREE_TYPE (upper_bound_field),
+		      triplet,
+		      upper_bound_field,
+		      NULL_TREE);
+}
+
+/* Return an expression that sets the upper bound of dimension DIM of the
+   multiple EXP to BOUND.  */
+
+tree
+a68_multiple_set_upper_bound (tree exp, tree dim, tree bound)
+{
+  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));
+  return fold_build2 (MODIFY_EXPR,
+		      TREE_TYPE (bound),
+		      a68_multiple_upper_bound (exp, dim),
+		      bound);
+}
+
+/* Return the stride of dimension DIM of the multiple EXP.  */
+
+tree
+a68_multiple_stride (tree exp, tree dim)
+{
+  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));
+
+  /* stride% is the third field in the triplet.  */
+  tree triplet = multiple_triplet (exp, dim);
+  tree stride_field = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (triplet))));
+  return fold_build3 (COMPONENT_REF,
+		      TREE_TYPE (stride_field),
+		      triplet,
+		      stride_field,
+		      NULL_TREE);
+}
+
+/* Return an expression that sets the stride of dimension DIM of the multiple
+   EXP to STRIDE.
+
+   STRIDE must be a sizetype.  */
+
+tree
+a68_multiple_set_stride (tree exp, tree dim, tree stride)
+{
+  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));
+  return fold_build2 (MODIFY_EXPR,
+		      TREE_TYPE (stride),
+		      a68_multiple_stride (exp, dim),
+		      stride);
+}
+
+/* Return the triplets of the multiple EXP.  */
+
+tree
+a68_multiple_triplets (tree exp)
+{
+  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));
+
+  /* triplets% is the first field in the descriptor.  */
+  tree triplets_field = TYPE_FIELDS (TREE_TYPE (exp));
+  return fold_build3 (COMPONENT_REF,
+		      TREE_TYPE (triplets_field),
+		      exp,
+		      triplets_field,
+		      NULL_TREE);
+}
+
+/* Return the pointer to the elements of the multiple EXP.  */
+
+tree
+a68_multiple_elements (tree exp)
+{
+  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp)));
+
+  /* elements% is the second field in the descriptor.  */
+  tree elements_field = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp)));
+  return fold_build3 (COMPONENT_REF,
+		      TREE_TYPE (elements_field),
+		      exp,
+		      elements_field,
+		      NULL_TREE);
+}
+
+/* Return an expression that sets the elements% field of EXP to ELEMENTS.  */
+
+tree
+a68_multiple_set_elements (tree exp, tree elements)
+{
+  /* elements% is the second field in the descriptor.  */
+  tree elements_field = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp)));
+  return fold_build2 (MODIFY_EXPR,
+		      TREE_TYPE (elements_field),
+		      fold_build3 (COMPONENT_REF,
+				   TREE_TYPE (elements_field),
+				   exp,
+				   elements_field,
+				   NULL_TREE),
+		      elements);
+}
+
+/* Return an expression that sets the elements_size% field of EXP to
+   ELEMENTS_SIZE, which must be a sizetype.  */
+
+tree
+a68_multiple_set_elements_size (tree exp, tree elements_size)
+{
+  /* elements_size% is the third field in the descriptor.  */
+  tree elements_size_field = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))));
+  return fold_build2 (MODIFY_EXPR,
+		      TREE_TYPE (elements_size_field),
+		      fold_build3 (COMPONENT_REF,
+				   TREE_TYPE (elements_size_field),
+				   exp,
+				   elements_size_field,
+				   NULL_TREE),
+		      elements_size);
+}
+
+/* Given two arrays of LOWER_BOUNDs and UPPER_BOUNDs corresponding to DIM
+   dimensions of a multiple of type TYPE, fill in the strides in STRIDES, which
+   is assumed to be a buffer big enough to hold DIM tree nodes.  The bounds
+   shall be of type ssizetype, and the calculated strides are of type sizetype,
+   i.e. unsigned.  */
+
+void
+a68_multiple_compute_strides (tree type, size_t dim,
+			      tree *lower_bounds, tree *upper_bounds,
+			      tree *strides)
+{
+  tree stride = size_in_bytes (a68_row_elements_type (type));
+  for (ssize_t i = dim - 1; i >= 0; --i)
+    {
+      strides[i] = stride;
+
+      /* Calculate the stride for the previous dimension.  */
+      tree dim_num_elems
+	= save_expr (fold_build2 (PLUS_EXPR,
+				  sizetype,
+				  fold_convert (sizetype,
+						fold_build2 (MINUS_EXPR, ssizetype,
+							     upper_bounds[i], lower_bounds[i])),
+				  size_one_node));
+      stride = fold_build2 (MULT_EXPR, sizetype, stride, dim_num_elems);
+    }
+}
+
+/* Return a constructor for a multiple of row type TYPE, using TRIPLETS and
+   ELEMENTS.  ELEMENTS_SIZE is the size in bytes of the memory pointed by
+   ELEMENTS.  */
+
+tree
+a68_row_value_raw (tree type, tree triplets,
+		   tree elements, tree elements_size)
+{
+  tree triplets_field;
+  tree elements_field;
+  tree elements_size_field;
+  vec <constructor_elt, va_gc> *ce = NULL;
+
+  gcc_assert (A68_ROW_TYPE_P (type));
+  triplets_field = TYPE_FIELDS (type);
+  elements_field = TREE_CHAIN (triplets_field);
+  elements_size_field = TREE_CHAIN (elements_field);
+  CONSTRUCTOR_APPEND_ELT (ce, triplets_field, triplets);
+  CONSTRUCTOR_APPEND_ELT (ce, elements_field,
+			  fold_build1 (CONVERT_EXPR ,TREE_TYPE (elements_field), elements));
+  CONSTRUCTOR_APPEND_ELT (ce, elements_size_field, elements_size);
+  return build_constructor (type, ce);
+}
+
+/* Return a constructor for a multiple of row type TYPE, of DIM dimensions and
+   pointing to ELEMENTS.
+
+   ELEMENTS_SIZE contains the size in bytes of the memory pointed by ELEMENTS.
+
+   *LOWER_BOUND and *UPPER_BOUND are the bounds for the DIM dimensions.
+*/
+
+tree
+a68_row_value (tree type, size_t dim,
+	       tree elements, tree elements_size,
+	       tree *lower_bound, tree *upper_bound)
+{
+  tree triplets_field;
+  tree elements_field;
+  tree elements_size_field;
+  vec <constructor_elt, va_gc> *ce = NULL;
+
+  gcc_assert (A68_ROW_TYPE_P (type));
+  triplets_field = TYPE_FIELDS (type);
+  elements_field = TREE_CHAIN (triplets_field);
+  elements_size_field = TREE_CHAIN (elements_field);
+
+  tree triplet_type = TREE_TYPE (TREE_TYPE (triplets_field));
+  tree lower_bound_field = TYPE_FIELDS (triplet_type);
+  tree upper_bound_field = TREE_CHAIN (TYPE_FIELDS (triplet_type));
+  tree stride_field = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (triplet_type)));
+
+  /* Calculate strides.  */
+  tree *strides = (tree *) xmalloc (sizeof (tree) * dim);
+  a68_multiple_compute_strides (type, dim, lower_bound, upper_bound, strides);
+
+  vec <constructor_elt, va_gc> *triplets_ce = NULL;
+  for (size_t i = 0; i < dim; ++i)
+    {
+      CONSTRUCTOR_APPEND_ELT (triplets_ce,
+			      size_int (i),
+			      build_constructor_va (triplet_type,
+						    3,
+						    lower_bound_field, lower_bound[i],
+						    upper_bound_field, upper_bound[i],
+						    stride_field, strides[i]));
+    }
+  free (strides);
+  CONSTRUCTOR_APPEND_ELT (ce, triplets_field,
+			  build_constructor (TREE_TYPE (triplets_field), triplets_ce));
+  CONSTRUCTOR_APPEND_ELT (ce, elements_field,
+			  fold_build1 (CONVERT_EXPR, TREE_TYPE (elements_field), elements));
+  CONSTRUCTOR_APPEND_ELT (ce, elements_size_field,
+			  elements_size ? elements_size : size_zero_node);
+  tree multiple = build_constructor (type, ce);
+  return multiple;
+}
+
+/* Build a tree to slice a multiple given a set of indexes.
+
+   P is the tree node corresponding to the slice.  It is used as the source of
+   location information.
+
+   MULTIPLE is the multiple value being sliced.  If SLICING_NAME is true, it
+   means the slicing operation is for a name and therefore it must yield a
+   name.
+
+   INDEXES is a list of NUM_INDEXES indexes, which are units.
+   NUM_INDEXES must match the dimension of the multiple.  */
+
+tree
+a68_multiple_slice (NODE_T *p,
+		    tree multiple, bool slicing_name,
+		    int num_indexes, tree *indexes)
+{
+  tree slice = NULL_TREE;
+  tree bounds_check = NULL_TREE;
+
+  multiple = save_expr (multiple);
+  tree index = NULL_TREE;
+  for (int idx = 0; idx < num_indexes; ++idx)
+    {
+      tree lower_bound = a68_multiple_lower_bound (multiple, size_int (idx));
+      tree index_expr = save_expr (indexes[idx]);
+
+      /* Do run-time bound checking if requested.  */
+      if (OPTION_BOUNDS_CHECKING (&A68_JOB))
+	{
+	  tree upper_bound = a68_multiple_upper_bound (multiple, size_int (idx));
+	  unsigned int lineno = NUMBER (LINE (INFO (p)));
+	  const char *filename_str = FILENAME (LINE (INFO (p)));
+	  tree filename = build_string_literal (strlen (filename_str) + 1,
+						    filename_str);
+	  tree call = a68_build_libcall (A68_LIBCALL_ARRAYBOUNDS,
+					 void_type_node, 5,
+					 filename,
+					 build_int_cst (unsigned_type_node, lineno),
+					 fold_convert (ssizetype, index_expr),
+					 fold_convert (ssizetype, lower_bound),
+					 fold_convert (ssizetype, upper_bound));
+	  call = fold_build2 (COMPOUND_EXPR, a68_bool_type, call, boolean_false_node);
+
+	  /* If LB > UB, the dimension contains no elements.
+	     Otherwise, it must hold IDX >= LB && IDX <= UB */
+	  tree dim_bounds_check = fold_build2 (TRUTH_AND_EXPR, sizetype,
+					       fold_build2 (LE_EXPR, ssizetype,
+							    lower_bound, upper_bound),
+					       fold_build2 (TRUTH_AND_EXPR,
+							    boolean_type_node,
+							    fold_build2 (GE_EXPR, ssizetype,
+									 fold_convert (ssizetype,
+										       index_expr),
+									 lower_bound),
+							    fold_build2 (LE_EXPR, ssizetype,
+									 fold_convert (ssizetype,
+										       index_expr),
+									 upper_bound)));
+	  dim_bounds_check = fold_build2_loc (a68_get_node_location (p),
+					      TRUTH_ORIF_EXPR,
+					      ssizetype,
+					      dim_bounds_check, call);
+
+	  /* bounds_check_ok || call_runtime_error */
+	  if (bounds_check == NULL_TREE)
+	    bounds_check = dim_bounds_check;
+	  else
+	    bounds_check = fold_build2 (TRUTH_ANDIF_EXPR,
+					ssizetype,
+					bounds_check,
+					dim_bounds_check);
+	}
+
+      /* Now add the effect of this dimension's subscript in the index.  Note
+	 that the stride is expressed in bytes.  */
+      tree stride = a68_multiple_stride (multiple, size_int (idx));
+      tree adjusted_index
+	= fold_convert (sizetype, fold_build2 (MINUS_EXPR, ssizetype,
+					       fold_convert (ssizetype, index_expr),
+					       lower_bound));
+      tree term = fold_build2 (MULT_EXPR, sizetype,
+			       adjusted_index, stride);
+      if (index == NULL_TREE)
+	index = term;
+      else
+	index = fold_build2 (PLUS_EXPR, sizetype,
+			     index, term);
+    }
+
+  tree elements = a68_multiple_elements (multiple);
+  tree element_pointer_type = TREE_TYPE (elements);
+  tree element_type = TREE_TYPE (element_pointer_type);
+
+  /* Now refer to the indexed element.  In case we are slicing a ref to a
+     multiple, return the address of the element and not the element
+     itself.  */
+  tree element_address = fold_build2 (POINTER_PLUS_EXPR,
+				      element_pointer_type,
+				      elements,
+				      index);
+  if (slicing_name)
+    slice = element_address;
+  else
+    slice = fold_build2 (MEM_REF,
+			 element_type,
+			 fold_build2 (POINTER_PLUS_EXPR,
+				      element_pointer_type,
+				      elements,
+				      index),
+			 fold_convert (element_pointer_type,
+				       integer_zero_node));
+
+  /* Prepend bounds checking code if necessary.  */
+  if (bounds_check != NULL_TREE)
+    {
+      slice = fold_build2_loc (a68_get_node_location (p),
+			       COMPOUND_EXPR,
+			       TREE_TYPE (slice),
+			       bounds_check,
+			       slice);
+    }
+
+  return slice;
+}
+
+/* Auxiliary routine for a68_multiple_copy_elemens.  */
+
+static tree
+copy_multiple_dimension_elems (size_t dim, size_t num_dimensions,
+			       tree to, tree from,
+			       tree to_elements, tree from_elements,
+			       tree *to_offset, tree *from_offset,
+			       tree *indexes)
+{
+  tree element_pointer_type = TREE_TYPE (from_elements);
+  tree element_type = TREE_TYPE (element_pointer_type);
+  tree upb = a68_multiple_upper_bound (from, size_int (dim));
+
+  char *name = xasprintf ("r%ld%%", dim);
+  indexes[dim] = a68_lower_tmpvar (name, ssizetype,
+				   a68_multiple_lower_bound (from,
+							     size_int (dim)));
+  free (name);
+
+  /* Loop body.  */
+  a68_push_range (NULL);
+  {
+    /* if (indexes[dim] > upb) break; */
+    a68_add_stmt (fold_build1 (EXIT_EXPR, void_type_node,
+			       fold_build2 (GT_EXPR, size_type_node,
+					    indexes[dim], upb)));
+
+    /* Add this dimension's contribution to the offsets.  */
+    tree index = fold_convert (sizetype,
+			       fold_build2 (MINUS_EXPR, ssizetype,
+					    upb, indexes[dim]));
+    *to_offset = fold_build2 (PLUS_EXPR, sizetype,
+			      *to_offset,
+			      fold_build2 (MULT_EXPR, sizetype,
+					   index,
+					   a68_multiple_stride (to, size_int (dim))));
+    *from_offset = fold_build2 (PLUS_EXPR, sizetype,
+				*from_offset,
+				fold_build2 (MULT_EXPR, sizetype,
+					     index,
+					     a68_multiple_stride (from, size_int (dim))));
+
+    if (dim == num_dimensions - 1)
+      {
+	/* Most inner loop, copy one element.  */
+
+	tree to_off = a68_lower_tmpvar ("to_offset%", sizetype, *to_offset);
+	tree from_off = a68_lower_tmpvar ("from_offset%", sizetype, *from_offset);
+
+	tree to_elem = fold_build2 (MEM_REF,
+				    element_type,
+				    fold_build2 (POINTER_PLUS_EXPR,
+						 element_pointer_type,
+						 to_elements,
+						 to_off),
+				    fold_convert (element_pointer_type,
+						  integer_zero_node));
+	tree from_elem = fold_build2 (MEM_REF,
+				      element_type,
+				      fold_build2 (POINTER_PLUS_EXPR,
+						   element_pointer_type,
+						   from_elements,
+						   from_off),
+				      fold_convert (element_pointer_type,
+						    integer_zero_node));
+
+	/* XXX
+	   if may_overlap then modify only if dst_offset < src_offset */
+	a68_add_stmt (fold_build2 (MODIFY_EXPR, element_type,
+				   to_elem, from_elem));
+      }
+    else
+      {
+	a68_add_stmt (copy_multiple_dimension_elems (dim + 1, num_dimensions,
+						     to, from,
+						     to_elements, from_elements,
+						     to_offset, from_offset,
+						     indexes));
+      }
+
+    /* indexes[dim]++ */
+    a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, ssizetype,
+			       indexes[dim], ssize_int (1)));
+  }
+  tree loop_body = a68_pop_range ();
+
+  return fold_build1 (LOOP_EXPR, void_type_node, loop_body);
+}
+
+/* Copy the elements of a given multiple (string) FROM to the multiple (string)
+   TO.
+
+   The dimensions and bounds of both multiples are supposed to match, and they
+   are supposed to not be flat.
+
+   XXX simple cases  with same strides may be done with a memcpy.
+   XXX compile this into a support routine to reduce code size.  */
+
+tree
+a68_multiple_copy_elems (MOID_T *mode, tree to, tree from)
+{
+  gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (to))
+	      && A68_ROW_TYPE_P (TREE_TYPE (from)));
+
+  /* Deflex modes as needed and determine dimension.  */
+  if (IS_FLEX (mode))
+    mode = SUB (mode);
+  int num_dimensions = (mode == M_STRING ? 1 : DIM (mode));
+
+  a68_push_range (NULL);
+  to = a68_lower_tmpvar ("to%", TREE_TYPE (to), to);
+  from = a68_lower_tmpvar ("from%", TREE_TYPE (from), from);
+  tree from_elements = a68_multiple_elements (from);
+  tree element_pointer_type = TREE_TYPE (from_elements);
+  from_elements = a68_lower_tmpvar ("from_elements%", element_pointer_type,
+				    from_elements);
+  tree to_elements = a68_lower_tmpvar ("to_elements%", element_pointer_type,
+				       a68_multiple_elements (to));
+
+  tree *indexes = (tree *) xmalloc (num_dimensions * sizeof (tree));
+  tree to_offset = size_zero_node;
+  tree from_offset = size_zero_node;
+  a68_add_stmt (copy_multiple_dimension_elems (0 /* dim */, num_dimensions,
+					       to, from,
+					       to_elements, from_elements,
+					       &to_offset, &from_offset,
+					       indexes));
+  free (indexes);
+  return a68_pop_range ();
+}
+
+/* Given a rows type, return the number of dimensions.  */
+
+tree
+a68_rows_dim (tree exp)
+{
+  gcc_assert (A68_ROWS_TYPE_P (TREE_TYPE (exp)));
+
+  /* dim% is the first field in the rows struct.  */
+  tree dim_field = TYPE_FIELDS (TREE_TYPE (exp));
+  return fold_build3 (COMPONENT_REF,
+		      TREE_TYPE (dim_field),
+		      exp,
+		      dim_field,
+		      NULL_TREE);
+}
+
+/* Given a multiple value, create a rows value reflecting the multiple's
+   dimensions and triplets.  */
+
+tree
+a68_rows_value (tree multiple)
+{
+  tree rows_type = CTYPE (M_ROWS);
+  tree dim_field = TYPE_FIELDS (rows_type);
+  tree triplets_field = TREE_CHAIN (dim_field);
+
+  tree dimensions = save_expr (a68_multiple_dimensions (multiple));
+  tree triplets = fold_build1 (ADDR_EXPR, TREE_TYPE (triplets_field),
+			       a68_multiple_triplets (multiple));
+  return build_constructor_va (rows_type, 2,
+			       dim_field, dimensions,
+			       triplets_field, triplets);
+}
+
+/* Given a rows value and a dimension number, return the upper bound or the
+   lower of the given dimension.  The returned bound is a ssizetype.
+
+   DIM must be a sizetype.  */
+
+static tree
+rows_lower_or_upper_bound (tree rows, tree dim, bool upper)
+{
+  tree rows_type = TREE_TYPE (rows);
+  tree triplet_type = a68_triplet_type ();
+  tree triplet_pointer_type = build_pointer_type (triplet_type);
+  tree triplet_lb_field = TYPE_FIELDS (triplet_type);
+  tree triplet_ub_field = TREE_CHAIN (TYPE_FIELDS (triplet_type));
+  tree triplets_field = TREE_CHAIN (TYPE_FIELDS (rows_type));
+  tree triplets = fold_build3 (COMPONENT_REF, triplet_pointer_type,
+			       rows, triplets_field, NULL_TREE);
+  tree triplet_offset = fold_build2 (MULT_EXPR, sizetype,
+				     dim,
+				     size_in_bytes (triplet_type));
+  tree bound = fold_build3 (COMPONENT_REF, ssizetype,
+			    fold_build1 (INDIRECT_REF, triplet_type,
+					 fold_build2 (POINTER_PLUS_EXPR,
+						      triplet_pointer_type,
+						      triplets,
+						      triplet_offset)),
+			    upper ? triplet_ub_field : triplet_lb_field,
+			    NULL_TREE);
+
+  return bound;
+}
+
+/* Return the lower bound of dimension DIM of ROWS.  */
+
+tree
+a68_rows_lower_bound (tree rows, tree dim)
+{
+  return rows_lower_or_upper_bound (rows, dim, false);
+}
+
+/* Return the upper bound of dimension DIM of ROWS.  */
+
+tree
+a68_rows_upper_bound (tree rows, tree dim)
+{
+  return rows_lower_or_upper_bound (rows, dim, true);
+}
+
+/* Return a tree that checks that a given INDEX is correct given a multiple's
+   bounds in a given rank DIM.
+
+   If UPPER_BOUND is true then INDEX shall be less or equal than the multiple's
+   upper bound.  Otherwise INDEX shall be bigger or equal than the multiple's
+   lower bound.
+
+   If the condition above doesn't hold then a call to a run-time function is
+   performed: if UPPER_BOUND is true then ARRAYUPPERBOUND is called.  Otherwise
+   ARRAYLOWERBOUND is called.  */
+
+tree
+a68_multiple_single_bound_check (NODE_T *p, tree dim,
+				 tree multiple, tree index, bool upper_bound)
+{
+  index = save_expr (index);
+  multiple = save_expr (multiple);
+
+  tree bound = (upper_bound
+		? a68_multiple_upper_bound (multiple, dim)
+		: a68_multiple_lower_bound (multiple, dim));
+  a68_libcall_fn libcall = (upper_bound
+			    ? A68_LIBCALL_ARRAYUPPERBOUND
+			    : A68_LIBCALL_ARRAYLOWERBOUND);
+
+  /* Build the call to ARRAY*BOUNDS. */
+  unsigned int lineno = NUMBER (LINE (INFO (p)));
+  const char *filename_str = FILENAME (LINE (INFO (p)));
+  tree filename = build_string_literal (strlen (filename_str) + 1,
+					filename_str);
+  tree call = a68_build_libcall (libcall,
+				 void_type_node, 4,
+				 filename,
+				 build_int_cst (unsigned_type_node, lineno),
+				 fold_convert (ssizetype, index),
+				 fold_convert (ssizetype, bound));
+  call = fold_build2 (COMPOUND_EXPR, a68_bool_type, call, boolean_false_node);
+
+  tree bounds_check = fold_build2 (upper_bound ? LE_EXPR : GE_EXPR,
+				   ssizetype,
+				   fold_convert (ssizetype, index),
+				   bound);
+  return fold_build2_loc (a68_get_node_location (p),
+			  TRUTH_ORIF_EXPR,
+			  ssizetype,
+			  bounds_check, call);
+}
+
+/* Return a tree that checks whether the given DIM is a valid dimension/rank of
+   a boundable object with dimension BOUNDABLE_DIM.  If the provided DIM is not
+   a valid dimention then a call to the run-time function ARRAYDIM is
+   performed.
+
+   BOUNDABLE_DIM and DIM must be of type sizetype.  They are both one-based.
+
+   The parse tree node P is used as the source for the filename and line number
+   passed to the run-time function.  */
+
+static tree
+a68_boundable_dim_check (NODE_T *p, tree boundable_dim, tree dim)
+{
+  boundable_dim = save_expr (boundable_dim);
+  dim = save_expr (dim);
+
+  /* Build the call to ARRAYDIM. */
+  unsigned int lineno = NUMBER (LINE (INFO (p)));
+  const char *filename_str = FILENAME (LINE (INFO (p)));
+  tree filename = build_string_literal (strlen (filename_str) + 1,
+					filename_str);
+  tree call = a68_build_libcall (A68_LIBCALL_ARRAYDIM,
+				 void_type_node, 4,
+				 filename,
+				 build_int_cst (unsigned_type_node, lineno),
+				 boundable_dim, dim);
+  call = fold_build2 (COMPOUND_EXPR, a68_bool_type, call, boolean_false_node);
+
+  tree dim_check = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
+				fold_build2 (GT_EXPR, boolean_type_node, dim, size_zero_node),
+				fold_build2 (LE_EXPR, boolean_type_node, dim, boundable_dim));
+  return fold_build2_loc (a68_get_node_location (p),
+			  TRUTH_ORIF_EXPR,
+			  ssizetype,
+			  dim_check, call);
+}
+
+/* Return a tree that checks whether the given DIM is a valid dimension/rank of
+   the given rows value ROWS.
+
+   DIM is a sizetype.
+   The parse tree node P is used as the source for the filename and line
+   number.  */
+
+tree
+a68_rows_dim_check (NODE_T *p, tree rows, tree dim)
+{
+  return a68_boundable_dim_check (p, a68_rows_dim (rows), dim);
+}
+
+/* Return a tree that checks whether the given DIM is a valid dimension/rank of
+   the given multiple value MULTIPLE.
+
+   DIM is a sizetype.
+   The parse tree node P is used as the source for the filename and line
+   number.  */
+
+tree
+a68_multiple_dim_check (NODE_T *p, tree multiple, tree dim)
+{
+  return a68_boundable_dim_check (p, a68_multiple_dimensions (multiple), dim);
+}
+
+/* Return a tree that checks whether the given INDEX falls within the bounds of
+   MULTIPLE in the rank DIM.  If the provided index is out of bounds then a
+   call to the run-time function ARRAYBOUNDS is performed.
+
+   DIM must be a sizetype.
+   MULTIPLE must be a multiple value.
+   INDEX must be a ssizetype.
+
+   The parse tree node P is used as the source for the filename and line number
+   passed to the run-time function.  */
+
+tree
+a68_multiple_bounds_check (NODE_T *p, tree dim,
+			   tree multiple, tree index)
+{
+  index = save_expr (index);
+  multiple = save_expr (multiple);
+
+  tree upper_bound = a68_multiple_upper_bound (multiple, dim);
+  tree lower_bound = a68_multiple_lower_bound (multiple, dim);
+
+  /* Build the call to ARRAYBOUNDS. */
+  unsigned int lineno = NUMBER (LINE (INFO (p)));
+  const char *filename_str = FILENAME (LINE (INFO (p)));
+  tree filename = build_string_literal (strlen (filename_str) + 1,
+					filename_str);
+  tree call = a68_build_libcall (A68_LIBCALL_ARRAYBOUNDS,
+				 void_type_node, 5,
+				 filename,
+				 build_int_cst (unsigned_type_node, lineno),
+				 fold_convert (ssizetype, index),
+				 fold_convert (ssizetype, lower_bound),
+				 fold_convert (ssizetype, upper_bound));
+  call = fold_build2 (COMPOUND_EXPR, a68_bool_type, call, boolean_false_node);
+
+  /* If LB > UB, the dimension contains no elements.
+     Otherwise, it must hold IDX >= LB && IDX <= UB */
+  tree bounds_check = fold_build2 (TRUTH_AND_EXPR, sizetype,
+				   fold_build2 (LE_EXPR, ssizetype,
+						lower_bound, upper_bound),
+				   fold_build2 (TRUTH_AND_EXPR,
+						boolean_type_node,
+						fold_build2 (GE_EXPR, ssizetype,
+							     fold_convert (ssizetype,
+									   index),
+							     lower_bound),
+						fold_build2 (LE_EXPR, ssizetype,
+							     fold_convert (ssizetype,
+									   index),
+							     upper_bound)));
+  return fold_build2_loc (a68_get_node_location (p),
+			  TRUTH_ORIF_EXPR,
+			  ssizetype,
+			  bounds_check, call);
+}
+
+/* Emit a run-time error if the bounds of M1 and M2 are not the same.  Both
+   multiples are assumed to have the same type and therefore feature the same
+   number of dimensions.  */
+
+tree
+a68_multiple_bounds_check_equal (NODE_T *p, tree m1, tree m2)
+{
+  m1 = save_expr (m1);
+  m2 = save_expr (m2);
+
+  /* First determine the rank of the multiples and check they match.  */
+  tree m1_dimensions = a68_multiple_dimensions (m1);
+  tree m2_dimensions = a68_multiple_dimensions (m2);
+  gcc_assert (TREE_CODE (m1_dimensions) == INTEGER_CST
+	      && TREE_CODE (m2_dimensions) == INTEGER_CST);
+
+  int dim1 = tree_to_shwi (m1_dimensions);
+  int dim2 = tree_to_shwi (m2_dimensions);
+  gcc_assert (dim1 == dim2);
+
+  a68_push_range (NULL /* VOID */);
+
+  /* For each dimension, check that bounds are the same in both multiples.  */
+  int i;
+  for (i = 0; i < dim1; ++i)
+    {
+      tree dim_tree = build_int_cst (ssizetype, i);
+      tree dim_plus_one = fold_build2 (PLUS_EXPR, ssizetype,
+				       dim_tree,
+				       fold_convert (ssizetype, size_one_node));
+
+      tree lb1 = save_expr (a68_multiple_lower_bound (m1, dim_tree));
+      tree lb2 = save_expr (a68_multiple_lower_bound (m2, dim_tree));
+
+      tree ub1 = save_expr (a68_multiple_upper_bound (m1, dim_tree));
+      tree ub2 = save_expr (a68_multiple_upper_bound (m2, dim_tree));
+
+      tree bounds_equal = fold_build2 (TRUTH_AND_EXPR,
+				       boolean_type_node,
+				       fold_build2 (EQ_EXPR, boolean_type_node,
+						    lb1, lb2),
+				       fold_build2 (EQ_EXPR, boolean_type_node,
+						    ub1, ub2));
+
+      unsigned int lineno = NUMBER (LINE (INFO (p)));
+      const char *filename_str = FILENAME (LINE (INFO (p)));
+      tree filename = build_string_literal (strlen (filename_str) + 1,
+					    filename_str);
+      tree call = a68_build_libcall (A68_LIBCALL_ARRAYBOUNDSMISMATCH,
+				     void_type_node, 7,
+				     filename,
+				     build_int_cst (unsigned_type_node, lineno),
+				     dim_plus_one,
+				     lb1, ub1, lb2, ub2);
+      call = fold_build2 (COMPOUND_EXPR, boolean_type_node, call, boolean_false_node);
+
+      tree check = fold_build2_loc (a68_get_node_location (p),
+				    TRUTH_ORIF_EXPR, boolean_type_node,
+				    bounds_equal,
+				    call);
+      a68_add_stmt (check);
+    }
+
+  return a68_pop_range ();
+}
+
+/* Allocate a multiple on the heap.
+
+   M is the mode the multiple to allocate.
+   DIM is the number of dimensions of the multiple.
+   ELEMS is a pointer to the elements of the multiple.
+   ELEMS_SIZE is the size in bytes of ELEMS.
+   *LOWER_BOUND and *UPPER_BOUND are the bounds for the DIM dimensions.  */
+
+tree
+a68_row_malloc (tree type, int dim, tree elems, tree elems_size,
+		tree *lower_bound, tree *upper_bound)
+{
+  tree ptr_to_type = build_pointer_type (type);
+
+  a68_push_range (NULL);
+
+  /* Allocate space for the descriptor.  */
+  tree ptr_to_multiple = a68_lower_tmpvar ("ptr_to_multiple%", ptr_to_type,
+					   a68_lower_malloc (type, size_in_bytes (type)));
+  tree multiple = a68_row_value (type, dim,
+				 elems, elems_size,
+				 lower_bound, upper_bound);
+  a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node,
+			     fold_build1 (INDIRECT_REF, type, ptr_to_multiple),
+			     multiple));
+  a68_add_stmt (ptr_to_multiple);
+  tree res = a68_pop_range ();
+  TREE_TYPE (res) = ptr_to_type;
+  return res;
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-posix.cc
@@ -0,0 +1,553 @@
+/* Lowering routines for the POSIX prelude.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Set the exit status of the running process, to be returned to the OS upon
+   exit.  */
+
+tree
+a68_posix_setexitstatus (void)
+{
+  return a68_get_libcall (A68_LIBCALL_SET_EXIT_STATUS);
+}
+
+/* Number of command line arguments passed to the program.  */
+
+tree
+a68_posix_argc (void)
+{
+  return a68_get_libcall (A68_LIBCALL_POSIX_ARGC);
+}
+
+/* Gets the Nth command line argument passed to the program.  If N is out of
+   range the result is an empty string.  */
+
+tree
+a68_posix_argv (void)
+{
+  static tree argv_fndecl;
+
+  if (argv_fndecl == NULL_TREE)
+    {
+      argv_fndecl
+	= a68_low_toplevel_func_decl ("argv",
+				      build_function_type_list (CTYPE (M_STRING),
+								a68_int_type,
+								NULL_TREE));
+      announce_function (argv_fndecl);
+
+      tree param = a68_low_func_param (argv_fndecl, "n", a68_int_type);
+      DECL_ARGUMENTS (argv_fndecl) = param;
+
+      a68_push_function_range (argv_fndecl, CTYPE (M_STRING),
+			       true /* top_level */);
+
+      a68_push_range (M_STRING);
+      tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0));
+      TREE_ADDRESSABLE (len) = 1;
+
+      tree ptrtochar_type = build_pointer_type (a68_char_type);
+      tree elems = a68_lower_tmpvar ("elems%", ptrtochar_type,
+				     a68_build_libcall (A68_LIBCALL_POSIX_ARGV,
+							ptrtochar_type, 2,
+							param,
+							fold_build1 (ADDR_EXPR, build_pointer_type (sizetype),
+								     len)));
+      tree lower_bound = ssize_int (1);
+      tree upper_bound = fold_convert (ssizetype, len);
+      tree elems_size = fold_build2 (MULT_EXPR, sizetype,
+				     len,
+				     size_in_bytes (a68_char_type));
+      a68_add_stmt (a68_row_value (CTYPE (M_STRING), 1 /* dim */,
+				   elems, elems_size,
+				   &lower_bound, &upper_bound));
+      tree body = a68_pop_range ();
+      a68_pop_function_range (body);
+    }
+
+  return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (argv_fndecl)),
+		      argv_fndecl);
+}
+
+/* Gets the value of an environment variable, or an empty string if the
+   variable is not set.  */
+
+tree
+a68_posix_getenv (void)
+{
+  static tree getenv_fndecl;
+
+  if (getenv_fndecl == NULL_TREE)
+    {
+      getenv_fndecl
+	= a68_low_toplevel_func_decl ("getenv",
+				      build_function_type_list (CTYPE (M_STRING),
+								CTYPE (M_STRING),
+								NULL_TREE));
+      announce_function (getenv_fndecl);
+
+      tree param = a68_low_func_param (getenv_fndecl, "varname", CTYPE (M_STRING));
+      DECL_ARGUMENTS (getenv_fndecl) = param;
+
+      a68_push_function_range (getenv_fndecl, CTYPE (M_STRING),
+			       true /* top_level */);
+
+      a68_push_range (M_STRING);
+
+      tree varname = a68_lower_tmpvar ("varname%", CTYPE (M_STRING),
+				       param);
+
+      tree ptrtochar_type = build_pointer_type (a68_char_type);
+      tree convelems = a68_lower_tmpvar ("convelems%", ptrtochar_type,
+					 build_int_cst (ptrtochar_type, 0));
+      TREE_ADDRESSABLE (convelems) = 1;
+      tree convelemslen = a68_lower_tmpvar ("convelemslen%", sizetype,
+					    size_int (0));
+      TREE_ADDRESSABLE (convelemslen) = 1;
+
+      tree call = a68_build_libcall (A68_LIBCALL_POSIX_GETENV,
+				     void_type_node, 5,
+				     a68_multiple_elements (varname),
+				     a68_multiple_num_elems (varname),
+				     a68_multiple_stride (varname, size_zero_node),
+				     fold_build1 (ADDR_EXPR, build_pointer_type (ptrtochar_type),
+						  convelems),
+				     fold_build1 (ADDR_EXPR, build_pointer_type (sizetype),
+						  convelemslen));
+      a68_add_stmt (call);
+      tree lower_bound = ssize_int (1);
+      tree upper_bound = fold_convert (ssizetype, convelemslen);
+      tree convelems_size = fold_build2 (MULT_EXPR, sizetype,
+					 convelemslen,
+					 size_in_bytes (a68_char_type));
+      a68_add_stmt (a68_row_value (CTYPE (M_STRING), 1 /* dim */,
+				   convelems, convelems_size,
+				   &lower_bound, &upper_bound));
+      tree body = a68_pop_range ();
+      a68_pop_function_range (body);
+    }
+
+  return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (getenv_fndecl)),
+		      getenv_fndecl);
+}
+
+tree
+a68_posix_putchar (void)
+{
+  return a68_get_libcall (A68_LIBCALL_POSIX_PUTCHAR);
+}
+
+tree
+a68_posix_puts (void)
+{
+  static tree puts_fndecl;
+
+  if (puts_fndecl == NULL_TREE)
+    {
+      puts_fndecl
+	= a68_low_toplevel_func_decl ("puts",
+				      build_function_type_list (void_type_node,
+								CTYPE (M_STRING),
+								NULL_TREE));
+      announce_function (puts_fndecl);
+
+      tree param = a68_low_func_param (puts_fndecl, "str", CTYPE (M_STRING));
+      DECL_ARGUMENTS (puts_fndecl) = param;
+
+      a68_push_function_range (puts_fndecl, void_type_node,
+			       true /* top_level */);
+
+      tree call = a68_build_libcall (A68_LIBCALL_POSIX_PUTS,
+				     void_type_node, 3,
+				     a68_multiple_elements (param),
+				     a68_multiple_num_elems (param),
+				     a68_multiple_stride (param, size_zero_node));
+      a68_pop_function_range (call);
+    }
+
+  return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (puts_fndecl)),
+		      puts_fndecl);
+}
+
+tree
+a68_posix_fconnect (void)
+{
+  static tree fconnect_fndecl;
+
+  if (fconnect_fndecl == NULL_TREE)
+    {
+      fconnect_fndecl
+	= a68_low_toplevel_func_decl ("fconnect",
+				      build_function_type_list (a68_int_type,
+								CTYPE (M_STRING),
+								a68_bits_type,
+								NULL_TREE));
+      announce_function (fconnect_fndecl);
+
+      tree host = a68_low_func_param (fconnect_fndecl, "host", CTYPE (M_STRING));
+      tree port = a68_low_func_param (fconnect_fndecl, "port", a68_int_type);
+      DECL_ARGUMENTS (fconnect_fndecl) = chainon (host, port);
+
+      a68_push_function_range (fconnect_fndecl, a68_int_type,
+			       true /* top_level */);
+
+
+      tree body = a68_build_libcall (A68_LIBCALL_POSIX_FCONNECT,
+				     a68_int_type, 4,
+				     a68_multiple_elements (host),
+				     a68_multiple_num_elems (host),
+				     a68_multiple_stride (host, size_zero_node),
+				     port);
+      a68_pop_function_range (body);
+    }
+
+  return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fconnect_fndecl)),
+		      fconnect_fndecl);
+}
+
+tree
+a68_posix_fcreate (void)
+{
+  static tree fcreate_fndecl;
+
+  if (fcreate_fndecl == NULL_TREE)
+    {
+      fcreate_fndecl
+	= a68_low_toplevel_func_decl ("fcreate",
+				      build_function_type_list (a68_int_type,
+								CTYPE (M_STRING),
+								a68_bits_type,
+								NULL_TREE));
+      announce_function (fcreate_fndecl);
+
+      tree pathname = a68_low_func_param (fcreate_fndecl, "pathname", CTYPE (M_STRING));
+      tree mode = a68_low_func_param (fcreate_fndecl, "mode", a68_int_type);
+      DECL_ARGUMENTS (fcreate_fndecl) = chainon (pathname, mode);
+
+      a68_push_function_range (fcreate_fndecl, a68_int_type,
+			       true /* top_level */);
+
+
+      tree body = a68_build_libcall (A68_LIBCALL_POSIX_FCREATE,
+				     a68_int_type, 4,
+				     a68_multiple_elements (pathname),
+				     a68_multiple_num_elems (pathname),
+				     a68_multiple_stride (pathname, size_zero_node),
+				     mode);
+      a68_pop_function_range (body);
+    }
+
+  return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fcreate_fndecl)),
+		      fcreate_fndecl);
+}
+
+tree
+a68_posix_fopen (void)
+{
+  static tree fopen_fndecl;
+
+  if (fopen_fndecl == NULL_TREE)
+    {
+      fopen_fndecl
+	= a68_low_toplevel_func_decl ("fopen",
+				      build_function_type_list (a68_int_type,
+								CTYPE (M_STRING),
+								a68_bits_type,
+								NULL_TREE));
+      announce_function (fopen_fndecl);
+
+      tree pathname = a68_low_func_param (fopen_fndecl, "pathname", CTYPE (M_STRING));
+      tree flags = a68_low_func_param (fopen_fndecl, "flags", a68_int_type);
+      DECL_ARGUMENTS (fopen_fndecl) = chainon (pathname, flags);
+
+      a68_push_function_range (fopen_fndecl, a68_int_type,
+			       true /* top_level */);
+
+
+      tree body = a68_build_libcall (A68_LIBCALL_POSIX_FOPEN,
+				     a68_int_type, 4,
+				     a68_multiple_elements (pathname),
+				     a68_multiple_num_elems (pathname),
+				     a68_multiple_stride (pathname, size_zero_node),
+				     flags);
+      a68_pop_function_range (body);
+    }
+
+  return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fopen_fndecl)),
+		      fopen_fndecl);
+}
+
+tree
+a68_posix_fclose (void)
+{
+  return a68_get_libcall (A68_LIBCALL_POSIX_FCLOSE);
+}
+
+tree
+a68_posix_fsize (void)
+{
+  return a68_get_libcall (A68_LIBCALL_POSIX_FSIZE);
+}
+
+tree
+a68_posix_errno (void)
+{
+  return a68_get_libcall (A68_LIBCALL_POSIX_ERRNO);
+}
+
+tree
+a68_posix_perror (void)
+{
+  static tree perror_fndecl;
+
+  if (perror_fndecl == NULL_TREE)
+    {
+      perror_fndecl
+	= a68_low_toplevel_func_decl ("perror",
+				      build_function_type_list (void_type_node,
+								CTYPE (M_STRING),
+								NULL_TREE));
+      announce_function (perror_fndecl);
+
+      tree str = a68_low_func_param (perror_fndecl, "str", CTYPE (M_STRING));
+      DECL_ARGUMENTS (perror_fndecl) = str;
+
+      a68_push_function_range (perror_fndecl, void_type_node,
+			       true /* top_level */);
+
+      tree body = a68_build_libcall (A68_LIBCALL_POSIX_PERROR,
+				     a68_int_type, 3,
+				     a68_multiple_elements (str),
+				     a68_multiple_num_elems (str),
+				     a68_multiple_stride (str, size_zero_node));
+      a68_pop_function_range (body);
+    }
+
+  return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (perror_fndecl)),
+		      perror_fndecl);
+}
+
+tree
+a68_posix_strerror (void)
+{
+  static tree strerror_fndecl;
+
+  if (strerror_fndecl == NULL_TREE)
+    {
+      strerror_fndecl
+	= a68_low_toplevel_func_decl ("strerror",
+				      build_function_type_list (CTYPE (M_STRING),
+								a68_int_type,
+								NULL_TREE));
+      announce_function (strerror_fndecl);
+
+      tree errnum = a68_low_func_param (strerror_fndecl, "errnum", a68_int_type);
+      DECL_ARGUMENTS (strerror_fndecl) = errnum;
+
+      a68_push_function_range (strerror_fndecl, CTYPE (M_STRING),
+			       true /* top_level */);
+
+      tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0));
+      TREE_ADDRESSABLE (len) = 1;
+
+      tree call = a68_build_libcall (A68_LIBCALL_POSIX_STRERROR,
+				     void_type_node, 2,
+				     errnum,
+				     fold_build1 (ADDR_EXPR, build_pointer_type (sizetype), len));
+      tree elems = a68_lower_tmpvar ("elems%", build_pointer_type (a68_char_type), call);
+
+      tree lower_bound = ssize_int (1);
+      tree upper_bound = fold_convert (ssizetype, len);
+      tree elems_size = fold_build2 (MULT_EXPR, sizetype,
+				     len, size_in_bytes (a68_char_type));
+
+      tree body = a68_row_value (CTYPE (M_STRING), 1 /* dim */,
+				 elems, elems_size,
+				 &lower_bound, &upper_bound);
+      a68_pop_function_range (body);
+    }
+
+  return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (strerror_fndecl)),
+		      strerror_fndecl);
+}
+
+tree
+a68_posix_getchar (void)
+{
+  return a68_get_libcall (A68_LIBCALL_POSIX_GETCHAR);
+}
+
+tree
+a68_posix_fgetc (void)
+{
+  return a68_get_libcall (A68_LIBCALL_POSIX_FGETC);
+}
+
+tree
+a68_posix_fputc (void)
+{
+  return a68_get_libcall (A68_LIBCALL_POSIX_FPUTC);
+}
+
+tree
+a68_posix_fputs (void)
+{
+  static tree fputs_fndecl;
+
+  if (fputs_fndecl == NULL_TREE)
+    {
+      fputs_fndecl
+	= a68_low_toplevel_func_decl ("fputs",
+				      build_function_type_list (a68_int_type,
+								a68_int_type,
+								CTYPE (M_STRING),
+								NULL_TREE));
+      announce_function (fputs_fndecl);
+
+      tree fd = a68_low_func_param (fputs_fndecl, "fd", a68_int_type);
+      tree str = a68_low_func_param (fputs_fndecl, "str", CTYPE (M_STRING));
+      DECL_ARGUMENTS (fputs_fndecl) = chainon (fd, str);
+
+      a68_push_function_range (fputs_fndecl, a68_int_type,
+			       true /* top_level */);
+
+
+      tree body = a68_build_libcall (A68_LIBCALL_POSIX_FPUTS,
+				     a68_int_type, 4,
+				     fd,
+				     a68_multiple_elements (str),
+				     a68_multiple_num_elems (str),
+				     a68_multiple_stride (str, size_zero_node));
+      a68_pop_function_range (body);
+    }
+
+  return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fputs_fndecl)),
+		      fputs_fndecl);
+}
+
+tree
+a68_posix_fgets (void)
+{
+  static tree fgets_fndecl;
+
+  if (fgets_fndecl == NULL_TREE)
+    {
+      fgets_fndecl
+	= a68_low_toplevel_func_decl ("fgets",
+				      build_function_type_list (CTYPE (M_REF_STRING),
+								a68_int_type,
+								a68_int_type,
+								NULL_TREE));
+      announce_function (fgets_fndecl);
+
+      tree fd = a68_low_func_param (fgets_fndecl, "fd", a68_int_type);
+      tree n = a68_low_func_param (fgets_fndecl, "n", a68_int_type);
+      DECL_ARGUMENTS (fgets_fndecl) = chainon (fd, n);
+
+      a68_push_function_range (fgets_fndecl, CTYPE (M_REF_STRING),
+			       true /* top_level */);
+
+      tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0));
+      TREE_ADDRESSABLE (len) = 1;
+
+      tree call = a68_build_libcall (A68_LIBCALL_POSIX_FGETS,
+				     CTYPE (M_REF_STRING), 3,
+				     fd, n,
+				     fold_build1 (ADDR_EXPR, build_pointer_type (sizetype), len));
+      tree elems = a68_lower_tmpvar ("elems%", build_pointer_type (a68_char_type), call);
+
+      tree lower_bound = ssize_int (1);
+      tree upper_bound = fold_convert (ssizetype, len);
+      tree elems_size = fold_build2 (MULT_EXPR, sizetype,
+				     len, size_in_bytes (a68_char_type));
+      tree body = a68_row_malloc (CTYPE (M_STRING), 1 /* dim */,
+				  elems, elems_size,
+				  &lower_bound, &upper_bound);
+      a68_pop_function_range (body);
+    }
+
+  return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fgets_fndecl)),
+		      fgets_fndecl);
+}
+
+tree
+a68_posix_gets (void)
+{
+  static tree gets_fndecl;
+
+  if (gets_fndecl == NULL_TREE)
+    {
+      gets_fndecl
+	= a68_low_toplevel_func_decl ("gets",
+				      build_function_type_list (CTYPE (M_REF_STRING),
+								a68_int_type,
+								NULL_TREE));
+      announce_function (gets_fndecl);
+
+      tree n = a68_low_func_param (gets_fndecl, "n", a68_int_type);
+      DECL_ARGUMENTS (gets_fndecl) = n;
+
+      a68_push_function_range (gets_fndecl, CTYPE (M_REF_STRING),
+			       true /* top_level */);
+
+      tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0));
+      TREE_ADDRESSABLE (len) = 1;
+
+      tree call = a68_build_libcall (A68_LIBCALL_POSIX_GETS,
+				     CTYPE (M_REF_STRING), 2,
+				     n, fold_build1 (ADDR_EXPR, build_pointer_type (sizetype), len));
+      tree elems = a68_lower_tmpvar ("elems%", build_pointer_type (a68_char_type), call);
+
+      tree lower_bound = ssize_int (1);
+      tree upper_bound = fold_convert (ssizetype, len);
+      tree elems_size = fold_build2 (MULT_EXPR, sizetype,
+				     len, size_in_bytes (a68_char_type));
+      tree body = a68_row_malloc (CTYPE (M_STRING), 1 /* dim */,
+				  elems, elems_size,
+				  &lower_bound, &upper_bound);
+      a68_pop_function_range (body);
+    }
+
+  return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (gets_fndecl)),
+		      gets_fndecl);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-prelude.cc
@@ -0,0 +1,2151 @@
+/* Lower Algol 68 pre-defined operators and procedures.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* The following handlers are for lowing the entities defined in
+   a68-parser-prelude.c.  */
+
+tree
+a68_lower_unimplemented (NODE_T *p,
+			 LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  fatal_error (a68_get_node_location (p),
+	       "no lowering routine installed for construct.  jemarch has been lazy");
+}
+
+tree
+a68_lower_charabs2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return a68_char_abs (op);
+}
+
+tree
+a68_lower_boolabs2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return a68_bool_abs (op);
+}
+
+tree
+a68_lower_intabs2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return a68_int_abs (op);
+}
+
+tree
+a68_lower_realabs2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return a68_real_abs (op);
+}
+
+tree
+a68_lower_confirm2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  /* Used to implement monadic +.  */
+  return a68_lower_tree (NEXT (SUB (p)), ctx);
+}
+
+tree
+a68_lower_negate2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  return fold_build1_loc (a68_get_node_location (p),
+			  NEGATE_EXPR,
+			  CTYPE (MOID (p)),
+			  a68_lower_tree (NEXT (SUB (p)), ctx));
+}
+
+/* Lower an ENTIER standard monadic operator.  */
+
+tree
+a68_lower_entier2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *op = NEXT (SUB (p));
+  return a68_real_entier (a68_lower_tree (op, ctx), MOID (p), MOID (op));
+}
+
+/* Lower a ROUND standard monadic operator.
+
+   This operator gets a LONGSETY REAL and produces a LONGSETY INT which is the
+   nearest integer to the given real.  */
+
+tree
+a68_lower_round2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *op = NEXT (SUB (p));
+  return a68_real_round (a68_lower_tree (op, ctx), MOID (p), MOID (op));
+}
+
+tree
+a68_lower_not2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  return fold_build1_loc (a68_get_node_location (p),
+			  TRUTH_NOT_EXPR,
+			  CTYPE (MOID (p)),
+			  a68_lower_tree (NEXT (SUB (p)), ctx));
+}
+
+tree
+a68_lower_and3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  return fold_build2_loc (a68_get_node_location (p),
+			  TRUTH_AND_EXPR,
+			  CTYPE (MOID (p)),
+			  a68_lower_tree (SUB (p), ctx),
+			  a68_lower_tree (NEXT (NEXT (SUB (p))), ctx));
+}
+
+tree
+a68_lower_or3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  return fold_build2_loc (a68_get_node_location (p),
+			  TRUTH_OR_EXPR,
+			  CTYPE (MOID (p)),
+			  a68_lower_tree (SUB (p), ctx),
+			  a68_lower_tree (NEXT (NEXT (SUB (p))), ctx));
+}
+
+tree
+a68_lower_xor3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  return fold_build2_loc (a68_get_node_location (p),
+			  TRUTH_XOR_EXPR,
+			  CTYPE (MOID (p)),
+			  a68_lower_tree (SUB (p), ctx),
+			  a68_lower_tree (NEXT (NEXT (SUB (p))), ctx));
+}
+
+tree
+a68_lower_plus_int (NODE_T *p, LOW_CTX_T ctx)
+{
+  MOID_T *m = MOID (p);
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_int_plus (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_plus_real (NODE_T *p, LOW_CTX_T ctx)
+{
+  MOID_T *m = MOID (p);
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_real_plus (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_minus_int (NODE_T *p, LOW_CTX_T ctx)
+{
+  MOID_T *m = MOID (p);
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_int_minus (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_minus_real (NODE_T *p, LOW_CTX_T ctx)
+{
+  MOID_T *m = MOID (p);
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_real_minus (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_mult_int (NODE_T *p, LOW_CTX_T ctx)
+{
+  MOID_T *m = MOID (p);
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_int_mult (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_mult_real (NODE_T *p, LOW_CTX_T ctx)
+{
+  MOID_T *m = MOID (p);
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_real_mult (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_multab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree lhs = a68_lower_tree (SUB (p), ctx);
+  lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+  lhs = save_expr (lhs);
+  NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+  tree rhs = a68_lower_tree (rhs_node, ctx);
+  tree operation = fold_build2_loc (a68_get_node_location (p),
+				    MULT_EXPR,
+				    TREE_TYPE (rhs),
+				    a68_low_deref (lhs, SUB (p)),
+				    rhs);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  COMPOUND_EXPR,
+			  TREE_TYPE (lhs),
+			  a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)),
+			  lhs);
+}
+
+tree
+a68_lower_over3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  MOID_T *m = MOID (p);
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_int_div (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_mod3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  MOID_T *m = MOID (p);
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_int_mod (m, op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_div3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_real_div (MOID (p),
+		       a68_lower_tree (SUB (p), ctx),
+		       a68_lower_tree (NEXT (NEXT (SUB (p))), ctx),
+		       a68_get_node_location (p));
+}
+
+tree
+a68_lower_rdiv3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_real_div (MOID (p),
+		       fold_build1 (FLOAT_EXPR, CTYPE (MOID (p)),
+				    a68_lower_tree (SUB (p), ctx)),
+		       fold_build1 (FLOAT_EXPR, CTYPE (MOID (p)),
+				    a68_lower_tree (NEXT (NEXT (SUB (p))), ctx)),
+		       a68_get_node_location (p));
+}
+
+tree
+a68_lower_int_eq3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_int_eq (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_int_ne3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_int_ne (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_int_lt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_int_lt (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_int_le3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_int_le (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_int_gt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_int_gt (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_int_ge3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_int_ge (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_real_eq3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_real_eq (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_real_ne3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_real_ne (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_real_lt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_real_lt (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_real_le3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_real_le (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_real_gt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_real_gt (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_real_ge3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_real_ge (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_char_eq3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_char_eq (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_char_ne3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_char_ne (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_char_lt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_char_lt (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_char_le3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_char_le (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_char_gt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_char_gt (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_char_ge3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_char_ge (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_bool_eq3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_bool_eq (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_bool_ne3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_bool_ne (op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_sign2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return a68_int_sign (op);
+}
+
+tree
+a68_lower_realsign2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return a68_real_sign (op);
+}
+
+tree
+a68_lower_plusab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree lhs = a68_lower_tree (SUB (p), ctx);
+  lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+  lhs = save_expr (lhs);
+  NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+  tree rhs = a68_lower_tree (rhs_node, ctx);
+  tree operation = fold_build2_loc (a68_get_node_location (p),
+				    PLUS_EXPR,
+				    TREE_TYPE (rhs),
+				    a68_low_deref (lhs, SUB (p)),
+				    rhs);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  COMPOUND_EXPR,
+			  TREE_TYPE (lhs),
+			  a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)),
+			  lhs);
+}
+
+tree
+a68_lower_minusab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree lhs = a68_lower_tree (SUB (p), ctx);
+  lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+  lhs = save_expr (lhs);
+  NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+  tree rhs = a68_lower_tree (rhs_node, ctx);
+  tree operation = fold_build2_loc (a68_get_node_location (p),
+				    MINUS_EXPR,
+				    TREE_TYPE (rhs),
+				    a68_low_deref (lhs, SUB (p)),
+				    rhs);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  COMPOUND_EXPR,
+			  TREE_TYPE (lhs),
+			  a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)),
+			  lhs);
+}
+
+tree
+a68_lower_overab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree lhs = a68_lower_tree (SUB (p), ctx);
+  lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+  lhs = save_expr (lhs);
+  NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+  tree rhs = a68_lower_tree (rhs_node, ctx);
+  tree operation = fold_build2_loc (a68_get_node_location (p),
+				    TRUNC_DIV_EXPR,
+				    TREE_TYPE (rhs),
+				    a68_low_deref (lhs, SUB (p)),
+				    rhs);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  COMPOUND_EXPR,
+			  TREE_TYPE (lhs),
+			  a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)),
+			  lhs);
+}
+
+tree
+a68_lower_modab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree lhs = a68_lower_tree (SUB (p), ctx);
+  lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+  lhs = save_expr (lhs);
+  NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+  tree rhs = a68_lower_tree (rhs_node, ctx);
+  tree operation = fold_build2_loc (a68_get_node_location (p),
+				    TRUNC_MOD_EXPR,
+				    TREE_TYPE (rhs),
+				    a68_low_deref (lhs, SUB (p)),
+				    rhs);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  COMPOUND_EXPR,
+			  TREE_TYPE (lhs),
+			  a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)),
+			  lhs);
+}
+
+tree
+a68_lower_divab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree lhs = a68_lower_tree (SUB (p), ctx);
+  lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+  lhs = save_expr (lhs);
+  NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+  tree rhs = a68_lower_tree (rhs_node, ctx);
+  tree operation = fold_build2_loc (a68_get_node_location (p),
+				    RDIV_EXPR,
+				    TREE_TYPE (rhs),
+				    a68_low_deref (lhs, SUB (p)),
+				    rhs);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  COMPOUND_EXPR,
+			  TREE_TYPE (lhs),
+			  a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)),
+			  lhs);
+}
+
+/* UPB comes in two flavors.
+
+   The unary operator returns the upper bound of the first dimension of the
+   operand multple.
+
+   The binary operator returns the upper bound of the given dimension of the
+   operand multiple.  The dimension is one-based.  If the specified dimension
+   is out of bounds then an a run-time error is raised.  */
+
+static tree
+upb (NODE_T *p, tree boundable, tree dim)
+{
+  boundable = save_expr (boundable);
+  dim = save_expr (dim);
+
+  /* BOUNDABLE can be a multiple or a ROWS.  */
+  tree zero_based_dim
+    = save_expr (fold_build2 (MINUS_EXPR, TREE_TYPE (dim), dim, size_one_node));
+  tree type = TREE_TYPE (boundable);
+  if (A68_ROW_TYPE_P (type))
+    {
+      return fold_build2 (COMPOUND_EXPR, ssizetype,
+			  a68_multiple_dim_check (p, boundable, dim),
+			  a68_multiple_upper_bound (boundable, zero_based_dim));
+    }
+  else if (A68_ROWS_TYPE_P (type))
+    {
+      return fold_build2 (COMPOUND_EXPR, ssizetype,
+			  a68_rows_dim_check (p, boundable, dim),
+			  a68_rows_upper_bound (boundable, zero_based_dim));
+    }
+  else
+    gcc_unreachable ();
+}
+
+tree
+a68_lower_upb2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree multiple = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return fold_convert (CTYPE (MOID (p)), upb (p, multiple, size_one_node));
+}
+
+tree
+a68_lower_upb3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree dim = fold_convert (sizetype, a68_lower_tree (SUB (p), ctx));
+  tree multiple = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return fold_convert (CTYPE (MOID (p)), upb (p, multiple, dim));
+}
+
+/* LWB comes in two flavors.
+
+   The unary operator returns the lower bound of the first dimension of the
+   operand multple.
+
+   The binary operator returns the lower bound of the given dimension of the
+   operand multiple.  The dimension is one-based.  If the specified dimension
+   is out of bounds then an a run-time error is raised.  */
+
+static tree
+lwb (NODE_T *p, tree boundable, tree dim)
+{
+  boundable = save_expr (boundable);
+  dim = save_expr (dim);
+
+  /* BOUNDABLE can be a multiple or an union whose all alternatives yield a
+     multiple.  */
+  tree zero_based_dim
+    = save_expr (fold_build2 (MINUS_EXPR, TREE_TYPE (dim), dim, size_one_node));
+  tree type = TREE_TYPE (boundable);
+  if (A68_ROW_TYPE_P (type))
+    {
+      return fold_build2 (COMPOUND_EXPR, ssizetype,
+			  a68_multiple_dim_check (p, boundable, dim),
+			  a68_multiple_lower_bound (boundable, zero_based_dim));
+    }
+  else if (A68_ROWS_TYPE_P (type))
+    {
+      return fold_build2 (COMPOUND_EXPR, ssizetype,
+			  a68_rows_dim_check (p, boundable, dim),
+			  a68_rows_lower_bound (boundable, zero_based_dim));
+    }
+  else
+    gcc_unreachable ();
+}
+
+tree
+a68_lower_lwb2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree multiple = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return fold_convert (CTYPE (MOID (p)), lwb (p, multiple, size_one_node));
+}
+
+tree
+a68_lower_lwb3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree dim = fold_convert (sizetype, a68_lower_tree (SUB (p), ctx));
+  tree multiple = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return fold_convert (CTYPE (MOID (p)), lwb (p, multiple, dim));
+}
+
+/* ELEMS comes in two flavors.
+
+   The unary operator returns the number of elements in the first dimension of
+   the operand multple.
+
+   DIM must be a size.
+
+   The binary operator returns the number of elements in the given dimension of the
+   operand multiple.  The dimension is one-based.  If the specified dimension
+   is out of bounds then an a run-time error is raised.  */
+
+static tree
+elems (NODE_T *p, tree boundable, tree dim)
+{
+  dim = save_expr (dim);
+
+  /* BOUNDABLE can be a multiple or a ROWS.  */
+  tree type = TREE_TYPE (boundable);
+
+  /* Make DIM zero-based.  */
+  tree dim_minus_one
+    = fold_build2 (MINUS_EXPR, TREE_TYPE (dim), dim, size_one_node);
+
+  boundable = save_expr (boundable);
+  tree upper_bound = NULL_TREE;
+  tree lower_bound = NULL_TREE;
+  tree check_dimension = NULL_TREE;
+  if (A68_ROW_TYPE_P (type))
+    {
+      upper_bound = a68_multiple_upper_bound (boundable, dim_minus_one);
+      lower_bound = a68_multiple_lower_bound (boundable, dim_minus_one);
+      check_dimension = a68_multiple_dim_check (p, boundable, dim);
+    }
+  else if (A68_ROWS_TYPE_P (type))
+    {
+      upper_bound = a68_rows_upper_bound (boundable, dim_minus_one);
+      lower_bound = a68_rows_lower_bound (boundable, dim_minus_one);
+      check_dimension = a68_rows_dim_check (p, boundable, dim);
+    }
+  else
+    gcc_unreachable ();
+
+  upper_bound = save_expr (upper_bound);
+  lower_bound = save_expr (lower_bound);
+
+  tree non_flat = fold_build2 (PLUS_EXPR,
+			       sizetype,
+			       fold_convert (sizetype,
+					     fold_build2 (MINUS_EXPR, ssizetype,
+							  upper_bound, lower_bound)),
+			       size_one_node);
+
+  tree elems = fold_build3 (COND_EXPR, sizetype,
+			    fold_build2 (LT_EXPR, boolean_type_node,
+					 upper_bound, lower_bound),
+			    size_zero_node,
+			    non_flat);
+
+  if (OPTION_BOUNDS_CHECKING (&A68_JOB))
+    elems = fold_build2 (COMPOUND_EXPR, sizetype,
+			 check_dimension,
+			 elems);
+
+  return elems;
+}
+
+tree
+a68_lower_elems2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree multiple = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return fold_convert (CTYPE (MOID (p)), elems (p, multiple, size_one_node));
+}
+
+tree
+a68_lower_elems3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree dim = fold_convert (sizetype, a68_lower_tree (SUB (p), ctx));
+  tree multiple = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return fold_convert (CTYPE (MOID (p)), elems (p, multiple, dim));
+}
+
+tree
+a68_lower_pow_int (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_int_pow (MOID (p), op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_pow_real (NODE_T *p, LOW_CTX_T ctx)
+{
+  MOID_T *mode = MOID (p);
+  MOID_T *op1_mode = MOID (SUB (p));
+  MOID_T *op2_mode = MOID (NEXT (NEXT (SUB (p))));
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_real_pow (mode, op1_mode, op2_mode,
+		       op1, op2, a68_get_node_location (p));
+}
+
+tree
+a68_lower_odd2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *op = NEXT (SUB (p));
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  EQ_EXPR,
+			  a68_bool_type,
+			  fold_build2 (BIT_AND_EXPR,
+				       CTYPE (MOID (op)),
+				       a68_lower_tree (op, ctx),
+				       build_int_cst (CTYPE (MOID (op)), 1)),
+			  build_int_cst (CTYPE (MOID (op)), 1));
+}
+
+tree
+a68_lower_string_eq3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  tree cmp = a68_string_cmp (op1, op2);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  EQ_EXPR,
+			  a68_bool_type,
+			  cmp,
+			  build_int_cst (a68_int_type, 0));
+}
+
+tree
+a68_lower_string_ne3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  tree cmp = a68_string_cmp (op1, op2);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  NE_EXPR,
+			  a68_bool_type,
+			  cmp,
+			  build_int_cst (a68_int_type, 0));
+}
+
+tree
+a68_lower_string_lt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  tree cmp = a68_string_cmp (op1, op2);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  LT_EXPR,
+			  a68_bool_type,
+			  cmp,
+			  build_int_cst (a68_int_type, 0));
+}
+
+tree
+a68_lower_string_le3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  tree cmp = a68_string_cmp (op1, op2);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  LE_EXPR,
+			  a68_bool_type,
+			  cmp,
+			  build_int_cst (a68_int_type, 0));
+}
+
+tree
+a68_lower_string_gt3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  tree cmp = a68_string_cmp (op1, op2);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  GT_EXPR,
+			  a68_bool_type,
+			  cmp,
+			  build_int_cst (a68_int_type, 0));
+}
+
+tree
+a68_lower_string_ge3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  tree cmp = a68_string_cmp (op1, op2);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  GE_EXPR,
+			  a68_bool_type,
+			  cmp,
+			  build_int_cst (a68_int_type, 0));
+}
+
+tree
+a68_lower_string_plus3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_string_concat (a68_lower_tree (SUB (p), ctx),
+			    a68_lower_tree (NEXT (NEXT (SUB (p))), ctx));
+}
+
+tree
+a68_lower_string_plusab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree lhs = a68_lower_tree (SUB (p), ctx);
+  lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+  lhs = save_expr (lhs);
+  NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+  tree rhs = a68_lower_tree (rhs_node, ctx);
+  tree operation = a68_string_concat (a68_low_deref (lhs, SUB (p)), rhs);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  COMPOUND_EXPR,
+			  TREE_TYPE (lhs),
+			  a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)),
+			  lhs);
+}
+
+tree
+a68_lower_string_plusto3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *lhs_node = NEXT (NEXT (SUB (p)));
+  tree lhs = a68_lower_tree (lhs_node, ctx);
+  lhs = a68_consolidate_ref (MOID (lhs_node), lhs);
+  lhs = save_expr (lhs);
+  MOID_T *lhs_mode = MOID (lhs_node);
+  NODE_T *rhs_node = SUB (p);
+  tree rhs = a68_lower_tree (rhs_node, ctx);
+  tree operation = a68_string_concat (rhs, a68_low_deref (lhs, NEXT (NEXT (SUB (p)))));
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  COMPOUND_EXPR,
+			  TREE_TYPE (lhs),
+			  a68_low_assignation (p, lhs, lhs_mode,
+					       operation, MOID (rhs_node)),
+			  lhs);
+}
+
+tree
+a68_lower_repr2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *op = NEXT (SUB (p));
+  return a68_char_repr (op, a68_lower_tree (op, ctx));
+}
+
+tree
+a68_lower_char_plus3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+  return a68_string_concat (a68_string_from_char (op1),
+			    a68_string_from_char (op2));
+}
+
+tree
+a68_lower_char_mult3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *n1 = SUB (p);
+  NODE_T *n2 = NEXT (NEXT (SUB (p)));
+
+  if (MOID (n1) == M_INT)
+    {
+      gcc_assert (MOID (n2) == M_STRING || MOID (n2) == M_ROW_CHAR);
+      return a68_string_mult (a68_string_from_char (a68_lower_tree (n2, ctx)),
+			      a68_lower_tree (n1, ctx));
+    }
+  else
+    {
+      gcc_assert (MOID (n1) == M_CHAR);
+      gcc_assert (MOID (n2) == M_INT);
+      return a68_string_mult (a68_string_from_char (a68_lower_tree (n1, ctx)),
+			      a68_lower_tree (n2, ctx));
+    }
+}
+
+tree
+a68_lower_string_mult3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *n1 = SUB (p);
+  NODE_T *n2 = NEXT (NEXT (SUB (p)));
+
+  if (MOID (n1) == M_INT)
+    {
+      gcc_assert (MOID (n2) == M_STRING || MOID (n2) == M_ROW_CHAR);
+      return a68_string_mult (a68_lower_tree (n2, ctx),
+			      a68_lower_tree (n1, ctx));
+    }
+  else
+    {
+      gcc_assert (MOID (n1) == M_STRING || MOID (n1) == M_ROW_CHAR);
+      gcc_assert (MOID (n2) == M_INT);
+      return a68_string_mult (a68_lower_tree (n1, ctx),
+			      a68_lower_tree (n2, ctx));
+    }
+}
+
+tree
+a68_lower_string_multab3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree lhs = a68_lower_tree (SUB (p), ctx);
+  lhs = a68_consolidate_ref (MOID (SUB (p)), lhs);
+  lhs = save_expr (lhs);
+  NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+  tree rhs = a68_lower_tree (rhs_node, ctx);
+  tree operation = a68_string_mult (a68_low_deref (lhs, SUB (p)), rhs);
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  COMPOUND_EXPR,
+			  TREE_TYPE (lhs),
+			  a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)),
+			  lhs);
+}
+
+/* SIZETY BITS operators.  */
+
+tree
+a68_lower_bin2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return a68_bits_bin (MOID (p), op);
+}
+
+tree
+a68_lower_bitabs2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return a68_bits_abs (MOID (p), op);
+}
+
+tree
+a68_lower_bitleng2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return a68_bits_leng (CTYPE (MOID (p)), op);
+}
+
+tree
+a68_lower_bitshorten2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return a68_bits_shorten (CTYPE (MOID (p)), op);
+}
+
+tree
+a68_lower_bitnot2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return a68_bits_not (op);
+}
+
+tree
+a68_lower_bitand3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_bits_and (op1, op2);
+}
+
+tree
+a68_lower_bitior3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_bits_ior (op1, op2);
+}
+
+tree
+a68_lower_bitxor3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_bits_xor (op1, op2);
+}
+
+tree
+a68_lower_shl3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree bits = a68_lower_tree (SUB (p), ctx);
+  tree shift = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_bits_shift (shift, bits);
+}
+
+tree
+a68_lower_shr3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree bits = a68_lower_tree (SUB (p), ctx);
+  tree shift = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_bits_shift (fold_build1 (NEGATE_EXPR,
+				      TREE_TYPE (shift), shift),
+			 bits);
+}
+
+tree
+a68_lower_bitelem3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree pos = a68_lower_tree (SUB (p), ctx);
+  tree bits = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_bits_elem (p, pos, bits);
+}
+
+tree
+a68_lower_bit_eq3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_bits_eq (op1, op2);
+}
+
+tree
+a68_lower_bit_ne3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_bits_ne (op1, op2);
+}
+
+tree
+a68_lower_bit_le3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_bits_subset (op1, op2);
+}
+
+tree
+a68_lower_bit_ge3 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  return a68_bits_subset (op2, op1);
+}
+
+/* Environment enquiries.  */
+
+tree
+a68_lower_maxint (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_int_maxval (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_minint (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_int_minval (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_maxbits (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_bits_maxbits (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_maxreal (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_real_maxval (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_minreal (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_real_minval (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_smallreal (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_real_smallval (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_bitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_bits_width (a68_bits_type);
+}
+
+tree
+a68_lower_longbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_bits_width (a68_long_bits_type);
+}
+
+tree
+a68_lower_longlongbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_bits_width (a68_long_long_bits_type);
+}
+
+tree
+a68_lower_shortbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_bits_width (a68_short_bits_type);
+}
+
+tree
+a68_lower_shortshortbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_bits_width (a68_short_short_bits_type);
+}
+
+tree
+a68_lower_intwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_int_width (a68_int_type);
+}
+
+tree
+a68_lower_longintwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_int_width (a68_long_int_type);
+}
+
+tree
+a68_lower_longlongintwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_int_width (a68_long_long_int_type);
+}
+
+tree
+a68_lower_shortintwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_int_width (a68_short_int_type);
+}
+
+tree
+a68_lower_shortshortintwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_int_width (a68_short_short_int_type);
+}
+
+tree
+a68_lower_realwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_real_width (a68_real_type);
+}
+
+tree
+a68_lower_longrealwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_real_width (a68_long_real_type);
+}
+
+tree
+a68_lower_longlongrealwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_real_width (a68_long_long_real_type);
+}
+
+tree
+a68_lower_expwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_real_exp_width (a68_real_type);
+}
+
+tree
+a68_lower_longexpwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_real_exp_width (a68_long_real_type);
+}
+
+tree
+a68_lower_longlongexpwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_real_exp_width (a68_long_long_real_type);
+}
+
+tree
+a68_lower_pi (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_real_pi (CTYPE (MOID (p)));
+}
+
+tree
+a68_lower_nullcharacter (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  static tree null_character = NULL_TREE;
+
+  if (null_character == NULL_TREE)
+    null_character = build_int_cst (a68_char_type, 0);
+  return null_character;
+}
+
+tree
+a68_lower_flip (NODE_T *p ATTRIBUTE_UNUSED,
+		LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  static tree flip = NULL_TREE;
+
+  if (flip == NULL_TREE)
+    flip = build_int_cst (a68_char_type, 84); /* T */
+  return flip;
+}
+
+tree
+a68_lower_invalidchar (NODE_T *p ATTRIBUTE_UNUSED,
+		       LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  static tree invalidchar = NULL_TREE;
+
+  if (invalidchar == NULL_TREE)
+    invalidchar = build_int_cst (a68_char_type, 0xfffd);
+  return invalidchar;
+}
+
+tree
+a68_lower_flop (NODE_T *p ATTRIBUTE_UNUSED,
+		LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  static tree flop = NULL_TREE;
+
+  if (flop == NULL_TREE)
+    flop = build_int_cst (a68_char_type, 70); /* F */
+  return flop;
+}
+
+tree
+a68_lower_errorchar (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  static tree errorchar = NULL_TREE;
+
+  if (errorchar == NULL_TREE)
+    errorchar = build_int_cst (a68_char_type, 42); /* * */
+  return errorchar;
+}
+
+tree
+a68_lower_blank (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  static tree blank = NULL_TREE;
+
+  if (blank == NULL_TREE)
+    blank = build_int_cst (a68_char_type, 32);
+  return blank;
+}
+
+tree
+a68_lower_intlengths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  HOST_WIDE_INT int_size = int_size_in_bytes (a68_int_type);
+  HOST_WIDE_INT long_int_size = int_size_in_bytes (a68_long_int_type);
+  HOST_WIDE_INT long_long_int_size = int_size_in_bytes (a68_long_long_int_type);
+
+  gcc_assert (int_size != -1);
+  gcc_assert (long_int_size != -1);
+  gcc_assert (long_long_int_size != -1);
+
+  int lengths = 1;
+  if (long_long_int_size != long_int_size)
+    lengths++;
+  if (long_int_size != int_size)
+    lengths++;
+
+  return build_int_cst (CTYPE (MOID (p)), lengths);
+}
+
+tree
+a68_lower_intshorths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  HOST_WIDE_INT int_size = int_size_in_bytes (a68_int_type);
+  HOST_WIDE_INT short_int_size = int_size_in_bytes (a68_short_int_type);
+  HOST_WIDE_INT short_short_int_size = int_size_in_bytes (a68_short_short_int_type);
+
+  gcc_assert (int_size != -1);
+  gcc_assert (short_int_size != -1);
+  gcc_assert (short_short_int_size != -1);
+
+  int shorths = 1;
+  if (short_short_int_size != short_int_size)
+    shorths++;
+  if (short_int_size != int_size)
+    shorths++;
+
+  return build_int_cst (CTYPE (MOID (p)), shorths);
+}
+
+tree
+a68_lower_bitslengths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  HOST_WIDE_INT bits_size = int_size_in_bytes (a68_bits_type);
+  HOST_WIDE_INT long_bits_size = int_size_in_bytes (a68_long_bits_type);
+  HOST_WIDE_INT long_long_bits_size = int_size_in_bytes (a68_long_long_bits_type);
+
+  gcc_assert (bits_size != -1);
+  gcc_assert (long_bits_size != -1);
+  gcc_assert (long_long_bits_size != -1);
+
+  int lengths = 1;
+  if (long_long_bits_size != long_bits_size)
+    lengths++;
+  if (long_bits_size != bits_size)
+    lengths++;
+
+  return build_int_cst (CTYPE (MOID (p)), lengths);
+}
+
+tree
+a68_lower_bitsshorths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  HOST_WIDE_INT bits_size = int_size_in_bytes (a68_bits_type);
+  HOST_WIDE_INT short_bits_size = int_size_in_bytes (a68_short_bits_type);
+  HOST_WIDE_INT short_short_bits_size = int_size_in_bytes (a68_short_short_bits_type);
+
+  gcc_assert (bits_size != -1);
+  gcc_assert (short_bits_size != -1);
+  gcc_assert (short_short_bits_size != -1);
+
+  int shorths = 1;
+  if (short_short_bits_size != short_bits_size)
+    shorths++;
+  if (short_bits_size != bits_size)
+    shorths++;
+
+  return build_int_cst (CTYPE (MOID (p)), shorths);
+}
+
+tree
+a68_lower_reallengths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  HOST_WIDE_INT real_size = int_size_in_bytes (a68_real_type);
+  HOST_WIDE_INT long_real_size = int_size_in_bytes (a68_long_real_type);
+  HOST_WIDE_INT long_long_real_size = int_size_in_bytes (a68_long_long_real_type);
+
+  gcc_assert (real_size != -1);
+  gcc_assert (long_real_size != -1);
+  gcc_assert (long_long_real_size != -1);
+
+  int lengths = 1;
+  if (long_long_real_size != long_real_size)
+    lengths++;
+  if (long_real_size != real_size)
+    lengths++;
+
+  return build_int_cst (CTYPE (MOID (p)), lengths);
+}
+
+tree
+a68_lower_realshorths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return build_int_cst (CTYPE (MOID (p)), 1);
+}
+
+tree
+a68_lower_infinity (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return build_real (CTYPE (MOID (p)), dconstinf);
+}
+
+tree
+a68_lower_minusinfinity (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return build_real (CTYPE (MOID (p)), dconstninf);
+}
+
+tree
+a68_lower_maxabschar (NODE_T *p ATTRIBUTE_UNUSED,
+		      LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_char_max ();
+}
+
+tree
+a68_lower_sqrt (NODE_T *p ATTRIBUTE_UNUSED,
+		LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_sqrt (a68_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_sqrt (NODE_T *p ATTRIBUTE_UNUSED,
+		     LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_sqrt (a68_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_long_sqrt (NODE_T *p ATTRIBUTE_UNUSED,
+			  LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_sqrt (a68_long_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_tan (NODE_T *p ATTRIBUTE_UNUSED,
+	       LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_tan (a68_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_tan (NODE_T *p ATTRIBUTE_UNUSED,
+		    LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_tan (a68_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_long_tan (NODE_T *p ATTRIBUTE_UNUSED,
+			 LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_tan (a68_long_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_sin (NODE_T *p ATTRIBUTE_UNUSED,
+	       LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_sin (a68_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_sin (NODE_T *p ATTRIBUTE_UNUSED,
+		    LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_sin (a68_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_long_sin (NODE_T *p ATTRIBUTE_UNUSED,
+			 LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_sin (a68_long_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_cos (NODE_T *p ATTRIBUTE_UNUSED,
+	       LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_cos (a68_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_cos (NODE_T *p ATTRIBUTE_UNUSED,
+		    LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_cos (a68_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_long_cos (NODE_T *p ATTRIBUTE_UNUSED,
+			 LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_cos (a68_long_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_acos (NODE_T *p ATTRIBUTE_UNUSED,
+		LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_acos (a68_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_acos (NODE_T *p ATTRIBUTE_UNUSED,
+		     LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_acos (a68_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_long_acos (NODE_T *p ATTRIBUTE_UNUSED,
+			  LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_acos (a68_long_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_asin (NODE_T *p ATTRIBUTE_UNUSED,
+		LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_asin (a68_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_asin (NODE_T *p ATTRIBUTE_UNUSED,
+		     LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_asin (a68_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_long_asin (NODE_T *p ATTRIBUTE_UNUSED,
+			  LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_asin (a68_long_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_atan (NODE_T *p ATTRIBUTE_UNUSED,
+		LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_atan (a68_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_atan (NODE_T *p ATTRIBUTE_UNUSED,
+		     LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_atan (a68_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_long_atan (NODE_T *p ATTRIBUTE_UNUSED,
+			  LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_atan (a68_long_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_ln (NODE_T *p ATTRIBUTE_UNUSED,
+	      LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_ln (a68_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_ln (NODE_T *p ATTRIBUTE_UNUSED,
+		   LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_ln (a68_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_long_ln (NODE_T *p ATTRIBUTE_UNUSED,
+			LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_ln (a68_long_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_log (NODE_T *p ATTRIBUTE_UNUSED,
+	       LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_log (a68_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_log (NODE_T *p ATTRIBUTE_UNUSED,
+		    LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_log (a68_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_long_log (NODE_T *p ATTRIBUTE_UNUSED,
+			 LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_log (a68_long_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_exp (NODE_T *p ATTRIBUTE_UNUSED,
+	       LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_exp (a68_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_exp (NODE_T *p ATTRIBUTE_UNUSED,
+		    LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_exp (a68_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_long_long_exp (NODE_T *p ATTRIBUTE_UNUSED,
+			 LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_real_exp (a68_long_long_real_type);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_reali (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  tree t = a68_complex_i (M_COMPLEX, op1, op2);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_longreali (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  tree t = a68_complex_i (M_LONG_COMPLEX, op1, op2);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_longlongreali (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  tree t = a68_complex_i (M_LONG_LONG_COMPLEX, op1, op2);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_inti (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  tree t = a68_complex_i (M_COMPLEX,
+			  convert_to_real (a68_real_type, op1),
+			  convert_to_real (a68_real_type, op2));
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_longinti (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  tree t= a68_complex_i (M_LONG_COMPLEX,
+			 convert_to_real (a68_long_real_type, op1),
+			 convert_to_real (a68_long_real_type, op2));
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_longlonginti (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op1 = a68_lower_tree (SUB (p), ctx);
+  tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+  tree t = a68_complex_i (M_LONG_LONG_COMPLEX,
+			  convert_to_real (a68_long_long_real_type, op1),
+			  convert_to_real (a68_long_long_real_type, op2));
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_re2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  tree t = a68_complex_re (op);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_im2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  tree t = a68_complex_im (op);
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_conj2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+  return a68_complex_conj (MOID (p), op);
+}
+
+tree
+a68_lower_shortenint2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_int_shorten (MOID (p), MOID (NEXT (SUB (p))),
+			  a68_lower_tree (NEXT (SUB (p)), ctx));
+}
+
+tree
+a68_lower_lengint2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_int_leng (MOID (p), MOID (NEXT (SUB (p))),
+		       a68_lower_tree (NEXT (SUB (p)), ctx));
+}
+
+tree
+a68_lower_shortenreal2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_real_shorten (MOID (p), MOID (NEXT (SUB (p))),
+			   a68_lower_tree (NEXT (SUB (p)), ctx));
+}
+
+tree
+a68_lower_lengreal2 (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_real_leng (MOID (p), MOID (NEXT (SUB (p))),
+			a68_lower_tree (NEXT (SUB (p)), ctx));
+}
+
+tree
+a68_lower_random (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_get_libcall (A68_LIBCALL_RANDOM);
+}
+
+tree
+a68_lower_longrandom (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  /* Note we dont build a call because this will get deprocedured in case it is
+     actually called.  */
+  return a68_get_libcall (A68_LIBCALL_LONGRANDOM);
+}
+
+tree
+a68_lower_longlongrandom (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_get_libcall (A68_LIBCALL_LONGLONGRANDOM);
+}
+
+/********* POSIX prelude.  ***************/
+
+tree
+a68_lower_setexitstatus (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_setexitstatus ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixargc (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_argc ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixargv (NODE_T *p ATTRIBUTE_UNUSED,
+		     LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_argv ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixgetenv (NODE_T *p ATTRIBUTE_UNUSED,
+		       LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_getenv ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixputchar (NODE_T *p ATTRIBUTE_UNUSED,
+			LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_putchar ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixputs (NODE_T *p ATTRIBUTE_UNUSED,
+		     LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_puts ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixfconnect (NODE_T *p ATTRIBUTE_UNUSED,
+			 LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_fconnect ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixfopen (NODE_T *p ATTRIBUTE_UNUSED,
+		      LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_fopen ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixfcreate (NODE_T *p ATTRIBUTE_UNUSED,
+			LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_fcreate ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixfclose (NODE_T *p ATTRIBUTE_UNUSED,
+		       LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_fclose ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixfsize (NODE_T *p ATTRIBUTE_UNUSED,
+		      LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_fsize ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixstdinfiledes (NODE_T *p ATTRIBUTE_UNUSED,
+			     LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return build_int_cst (a68_int_type, 0);
+}
+
+tree
+a68_lower_posixstdoutfiledes (NODE_T *p ATTRIBUTE_UNUSED,
+			      LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return build_int_cst (a68_int_type, 1);
+}
+
+tree
+a68_lower_posixstderrfiledes (NODE_T *p ATTRIBUTE_UNUSED,
+			      LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return build_int_cst (a68_int_type, 2);
+}
+
+tree
+a68_lower_posixfileodefault (NODE_T *p ATTRIBUTE_UNUSED,
+			     LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  /* Please keep in sync with libga68/ga68-posix.c  */
+  return build_int_cst (a68_bits_type, 0x0);
+}
+
+tree
+a68_lower_posixfileordwr (NODE_T *p ATTRIBUTE_UNUSED,
+			  LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  /* Please keep in sync with libga68/ga68-posix.c  */
+  return build_int_cst (a68_bits_type, 0x3);
+}
+
+tree
+a68_lower_posixfileordonly (NODE_T *p ATTRIBUTE_UNUSED,
+			    LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  /* Please keep in sync with libga68/ga68-posix.c  */
+  return build_int_cst (a68_bits_type, 0x1);
+}
+
+tree
+a68_lower_posixfileowronly (NODE_T *p ATTRIBUTE_UNUSED,
+			    LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  /* Please keep in sync with libga68/ga68-posix.c  */
+  return build_int_cst (a68_bits_type, 0x2);
+}
+
+tree
+a68_lower_posixfileotrunc (NODE_T *p ATTRIBUTE_UNUSED,
+			   LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  /* Please keep in sync with libga68/ga68-posix.c  */
+  return build_int_cst (a68_bits_type, 0x4);
+}
+
+tree
+a68_lower_posixerrno (NODE_T *p ATTRIBUTE_UNUSED,
+		      LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_errno ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixperror (NODE_T *p ATTRIBUTE_UNUSED,
+		       LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_perror ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixstrerror (NODE_T *p ATTRIBUTE_UNUSED,
+			 LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_strerror ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixfputc (NODE_T *p ATTRIBUTE_UNUSED,
+		      LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_fputc ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixfputs (NODE_T *p ATTRIBUTE_UNUSED,
+		      LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_fputs ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixgetchar (NODE_T *p ATTRIBUTE_UNUSED,
+			LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_getchar ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+
+tree
+a68_lower_posixfgetc (NODE_T *p ATTRIBUTE_UNUSED,
+		      LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_fgetc ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixgets (NODE_T *p ATTRIBUTE_UNUSED,
+		     LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_gets ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
+
+tree
+a68_lower_posixfgets (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree t = a68_posix_fgets ();
+  if (CAN_HAVE_LOCATION_P (t))
+    SET_EXPR_LOCATION (t, a68_get_node_location (p));
+  return t;
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-procs.cc
@@ -0,0 +1,52 @@
+/* Lowering routines for all things related to procedures.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielding of SKIP for the given procedure mode.  */
+
+tree
+a68_get_proc_skip_tree (MOID_T *m)
+{
+  /* A SKIP for a procecure mode lowers to a NULL pointer to a function.  */
+  return build_int_cst (CTYPE (m), 0);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-ranges.cc
@@ -0,0 +1,697 @@
+/* Management of ranges in the Algol 68 front-end.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+#include "tree-nested.h"
+
+#include "a68.h"
+
+/* Many Algol 68 constructions introduce a new range of definitions.  This is
+   the case of clauses and of routine definitions.  The stack of ranges at any
+   point in the program determines the "nest" of the constructions declared in
+   the program.  This nest carries a record of all the declarations forming the
+   environment in which that construct is to be interpreted.
+
+   This file contains a manager of ranges of which we allocate one for each
+   range inducing construct.  The top-level range corresponds to the primal
+   environment.
+
+   The ranges are used by the lowering code in order to create GCC tree BLOCK
+   nodes, and also to keep track of the set of declarations and of statements
+   being added by the current serial clause.  */
+
+struct GTY (()) range
+{
+  /* Whether this range entry doesn't introduce a lexical frame.  Declarations
+     and decl_exprs get added to the nearst enclosing range that is not
+     frameless.  */
+  bool frameless;
+
+  /* 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 statements list of DECL_EXPR nodes for all the declarations in the
+     range.  These are prepended to the statements list when the range is
+     closed.  */
+  tree decl_exprs;
+
+  /* The context of the range, either a function declaration or a translation
+     unit.  */
+  tree context;
+
+  /* The range below this one.  */
+  struct range *next;
+
+  /* Statement list.  */
+  tree stmt_list;
+
+  /* List of blocks to which the block created for this range is the
+     superblock.  */
+  tree blocks;
+
+  /* Mode associated with the range.  For serial clauses, this is the mode of
+     the value yielded by the clause.  */
+  MOID_T *mode;
+
+  /* If not TREE_NULL, then the range corresponds to a function, which can be
+     either nested or defined at top-level.  */
+  tree fndecl;
+  bool top_level_function;
+
+  /* The following fields are used by ranges introduced by serial
+     clauses.  */
+  bool save_restore_stack;
+  bool has_completers;
+  tree clause_result_decl;
+  tree clause_exit_label_decl;
+  tree clause_stack_save_decl;
+};
+
+/* Global and current ranges.  */
+
+static GTY (()) struct range *global_range;
+static GTY (()) struct range *current_range;
+
+/* Create a new range and push it in the list.  */
+
+static struct range *
+new_range (void)
+{
+  struct range *range = ggc_alloc<struct range> ();
+
+  range->frameless = false;
+  range->names = NULL;
+  range->decl_exprs = alloc_stmt_list ();
+  range->context = NULL;
+  range->next = NULL;
+  range->blocks = NULL_TREE;
+  range->stmt_list = alloc_stmt_list ();
+  range->fndecl = NULL_TREE;
+  range->top_level_function = false;
+  range->save_restore_stack = false;
+  range->has_completers = false;
+  range->clause_result_decl = NULL_TREE;
+  range->clause_exit_label_decl = NULL_TREE;
+  range->clause_stack_save_decl = NULL_TREE;
+  range->mode = NO_MOID;
+  return range;
+}
+
+/* Push a new frameless range.  */
+
+void
+a68_push_stmt_list (MOID_T *mode)
+{
+  a68_push_range (mode);
+  current_range->frameless = true;
+}
+
+/* Pop a frameless range.  */
+
+tree
+a68_pop_stmt_list (void)
+{
+  /* This will result into a stmt list.  */
+  tree res = a68_pop_range ();
+  gcc_assert (TREE_CODE (res) == STATEMENT_LIST);
+  return res;
+}
+
+/* Push a new range.  */
+
+void
+a68_push_range (MOID_T *mode)
+{
+  struct range *range = new_range ();
+  if (current_range)
+    range->context = current_range->context;
+  range->next = current_range;
+  range->mode = mode;
+  current_range = range;
+}
+
+/* Pop a range, with a finalizer.
+
+   Return a BIND_EXPR, a statement list or a TRY_FINALLY_EXPR.  */
+
+tree
+a68_pop_range_with_finalizer (tree finalizer)
+{
+  tree range = a68_pop_range ();
+  return fold_build2 (TRY_FINALLY_EXPR, TREE_TYPE (range),
+		      range, finalizer);
+}
+
+/* Pop a range.  Return either a BIND_EXPR or a statements list.  */
+
+tree
+a68_pop_range (void)
+{
+  struct range *range = current_range;
+  current_range = range->next;
+  tree type = (range->mode == NULL ? void_type_node : CTYPE (range->mode));
+
+  /* If TYPE is a pointer type and the last expression in the statement list is
+     a variable of the type pointed by TYPE then take its address.  */
+  tree_stmt_iterator i = tsi_last (range->stmt_list);
+  if (POINTER_TYPE_P (type) && TREE_TYPE (type) == TREE_TYPE (tsi_stmt (i)))
+    {
+      append_to_statement_list_force (a68_consolidate_ref (range->mode, tsi_stmt (i)),
+				      &range->stmt_list);
+      tsi_delink (&i);
+    }
+
+  tree clause = NULL_TREE;
+  if (range->frameless)
+    clause = range->stmt_list;
+  else
+    {
+      /* Create a block and set its declarations and supercontext.  */
+      tree block = make_node (BLOCK);
+      BLOCK_VARS (block) = range->names;
+      BLOCK_SUBBLOCKS (block) = range->blocks;
+
+      /* In each subblock, record that this is its superior.  */
+      for (tree t = range->blocks; t; t = BLOCK_CHAIN (t))
+	BLOCK_SUPERCONTEXT (t) = block;
+
+      if (range->fndecl)
+	{
+	  BLOCK_SUPERCONTEXT (block) = range->fndecl;
+	  DECL_INITIAL (range->fndecl) = block;
+	}
+      else
+	{
+	  current_range->blocks
+	    = block_chainon (current_range->blocks, block);
+	}
+
+      TREE_USED (block) = true;
+
+      /* Create a BIND if the range contains declarations.  Otherwise just
+	 use the statements list.  */
+      clause = range->stmt_list;
+      if (range->names != NULL_TREE)
+	{
+	  clause = build3 (BIND_EXPR,
+			   type,
+			   range->names,
+			   range->stmt_list,
+			   block);
+	  TREE_SIDE_EFFECTS (clause) = 1;
+	  BIND_EXPR_VARS (clause) = BLOCK_VARS (block);
+	}
+
+      /* Prepend the decl_exprs to the range's statements list.  */
+      tree_stmt_iterator q = tsi_start (range->stmt_list);
+      tsi_link_before (&q, range->decl_exprs, TSI_SAME_STMT);
+    }
+
+  /* Set the type of the stmt_list.  */
+  TREE_TYPE (range->stmt_list) = type;
+  TREE_SIDE_EFFECTS (range->stmt_list) = 1;
+
+  return clause;
+}
+
+/* Add a new expression to the current range.  */
+
+void
+a68_add_stmt (tree exp)
+{
+  if (exp == void_node)
+    /* This may result from a mode declaration.  */
+    return;
+  gcc_assert (current_range != NULL);
+  append_to_statement_list_force (exp,
+				  &current_range->stmt_list);
+}
+
+/* Add a new declaration to the current range.  */
+
+void
+a68_add_decl (tree decl)
+{
+  gcc_assert (current_range != NULL);
+  struct range *range = current_range;
+
+  /* Search for the right frame where to add the declaration.  */
+  while (range->frameless)
+    {
+      gcc_assert (range->next != NULL);
+      range = range->next;
+    }
+
+  tree n = range->names;
+  while (n != decl && n != NULL)
+    n = TREE_CHAIN (n);
+  if (n != decl)
+    {
+      if (decl != current_function_decl)
+	DECL_CONTEXT (decl) = range->context;
+      /* Note this list needs to be in reverse order for compatibility with
+	 GCC.  */
+      TREE_CHAIN (decl) = range->names;
+      range->names = decl;
+    }
+}
+
+/* Add a new declaration expr to the current range.  */
+
+void
+a68_add_decl_expr (tree decl_expr)
+{
+  gcc_assert (current_range != NULL);
+  struct range *range = current_range;
+
+  /* Search for the right frame where to add the declaration expr.  */
+  while (range->frameless)
+    {
+      gcc_assert (range->next != NULL);
+      range = range->next;
+    }
+
+  append_to_statement_list_force (decl_expr, &range->decl_exprs);
+}
+
+/* Add a completer in the current range.  */
+
+void
+a68_add_completer (void)
+{
+  struct range *range = current_range;
+
+  /* The last statement in the statements list is either a single unit or a
+     labeled unit, i.e a COMPOUND_EXPR whose first expression is a label and
+     second expression is the unit.  Consolidate the unit within the labeled
+     unit to a ref.  */
+  tree_stmt_iterator i = tsi_last (range->stmt_list);
+  tree last_expr = tsi_stmt (i);
+
+  if (TREE_CODE (last_expr) == COMPOUND_EXPR
+      && TREE_CODE (TREE_OPERAND (last_expr, 0)) == LABEL_EXPR)
+    {
+      TREE_OPERAND (last_expr, 1) = a68_consolidate_ref (range->mode,
+							 TREE_OPERAND (last_expr, 1));
+      TREE_TYPE (last_expr) = TREE_TYPE (TREE_OPERAND (last_expr, 1));
+    }
+  else
+    last_expr = a68_consolidate_ref (range->mode, last_expr);
+
+  /* Now assign the labeled unit to the clause result decl then jump to the end
+     of the serial clause.  */
+  append_to_statement_list_force (fold_build2 (MODIFY_EXPR,
+					       void_type_node,
+					       range->clause_result_decl,
+					       last_expr),
+				  &range->stmt_list);
+  tsi_delink (&i);
+  append_to_statement_list_force (fold_build1 (GOTO_EXPR, void_type_node,
+					       range->clause_exit_label_decl),
+				  &range->stmt_list);
+  range->has_completers = true;
+}
+
+/* Get the context of the current range.  */
+
+tree
+a68_range_context (void)
+{
+  gcc_assert (current_range != NULL);
+  return current_range->context;
+}
+
+/* Get the list of declarations in the current range.  */
+
+tree
+a68_range_names (void)
+{
+  struct range *range = current_range;
+
+  while (range->frameless && range->next != NULL)
+    range = range->next;
+
+  if (range != NULL)
+    return range->names;
+  else
+    return NULL_TREE;
+}
+
+/* Get the statements list of the current range.  */
+
+tree
+a68_range_stmt_list (void)
+{
+  gcc_assert (current_range != NULL);
+  return current_range->stmt_list;
+}
+
+/* Push a range for a function.  */
+
+void
+a68_push_function_range (tree fndecl, tree result_type,
+			 bool top_level)
+{
+  a68_push_range (NULL /* VOID */);
+  current_range->fndecl = fndecl;
+  current_range->top_level_function = top_level;
+  current_range->context = fndecl;
+
+  /* Setup the result declaration.  */
+  tree resdecl = build_decl (UNKNOWN_LOCATION,
+			     RESULT_DECL,
+			     get_identifier ("resdecl%"),
+			     result_type);
+  DECL_ARTIFICIAL (resdecl) = 1;
+  DECL_IGNORED_P (resdecl) = 1;
+  DECL_CONTEXT (resdecl) = fndecl;
+  DECL_RESULT (fndecl) = resdecl;
+  rest_of_decl_compilation (fndecl, 1, 0);
+  make_decl_rtl (fndecl);
+  allocate_struct_function (fndecl, false);
+
+  /* Let GCC know the current scope is this function.  */
+  current_function_decl = fndecl;
+}
+
+/* Pop a range for a function.  */
+
+void
+a68_pop_function_range (tree body)
+{
+  tree fndecl = current_range->fndecl;
+  bool top_level = current_range->top_level_function;
+
+  if (TREE_TYPE (DECL_RESULT (fndecl)) == void_type_node)
+    {
+      a68_add_stmt (body);
+    }
+  else
+    {
+      /* Append the return statement.
+	 Note that this does the copy of the returned value.  */
+      tree return_stmt = fold_build1 (RETURN_EXPR,
+				      void_type_node,
+				      fold_build2 (MODIFY_EXPR,
+						   TREE_TYPE (DECL_RESULT (fndecl)),
+						   DECL_RESULT (fndecl),
+						   a68_low_dup (body, true /* use_heap */)));
+      a68_add_stmt (return_stmt);
+    }
+
+  /* Set the body of the function.  */
+  DECL_SAVED_TREE (fndecl) = a68_pop_range ();
+
+  /* Output the GENERIC tree for the function..  */
+  dump_function (TDI_original, fndecl);
+  /* This compiles the function all the way to assembler language output.
+     Nested functions are finalized when the containing top-level function is
+     finalized.  */
+  if (top_level || a68_in_global_range ())
+    cgraph_node::finalize_function (fndecl, true);
+  else
+    /* Register this function with cgraph just far enough to get it added to
+       our parent's nested function list.  */
+    (void) cgraph_node::get_create (fndecl);
+
+  /* Let GCC know the current scope has changed.  */
+  current_function_decl = NULL_TREE;
+  for (struct range *r = current_range; r; r = r->next)
+    {
+      if (r->fndecl != NULL_TREE)
+	current_function_decl = r->fndecl;
+    }
+}
+
+/* Push a range for a serial clause.
+
+    label1:                 BIND_EXPR_BODY (STATEMENT_LIST (
+     expr1;                  label1,
+     expr2                   expr1,
+   exit label2:              clause_result = expr2,
+     expr3;                  goto exit_label,
+     expr4                   label2,
+   exit label3:              expr3,
+     expr5                   clause_result = expr4,
+                             goto exit_label,
+                             label3,
+                             clause_result = expr5,
+                             exit_label,
+			     clause_result)) */
+
+void
+a68_push_serial_clause_range (MOID_T *clause_mode,
+			      bool save_restore_stack)
+{
+  /* Get the type of the enclosing clause.  */
+  tree clause_type = CTYPE (clause_mode);
+
+  /* If the serial clause has declarations that involve dynamic allocation, and
+     the environ it establishes is local, then save the stack pointer.  */
+  if (save_restore_stack)
+    {
+      a68_push_range (clause_mode);
+      current_range->save_restore_stack = true;
+
+      tree outer_clause_result_decl = build_decl (UNKNOWN_LOCATION,
+						  VAR_DECL,
+						  NULL, /* Set below.  */
+						  clause_type);
+      char *outer_clause_result_name = xasprintf ("outer_clause_result%d%%",
+						  DECL_UID (outer_clause_result_decl));
+      DECL_NAME (outer_clause_result_decl) = get_identifier (outer_clause_result_name);
+      free (outer_clause_result_name);
+      current_range->clause_result_decl = outer_clause_result_decl;
+      a68_add_decl (outer_clause_result_decl);
+
+      /* Variable used to save the stack pointer.  */
+      tree stack_save_decl = build_decl (UNKNOWN_LOCATION,
+					 VAR_DECL,
+					 get_identifier ("stack_save%"),
+					 build_pointer_type (char_type_node));
+      current_range->clause_stack_save_decl = stack_save_decl;
+      a68_add_decl (stack_save_decl);
+      a68_add_stmt (fold_build1 (DECL_EXPR,
+				 TREE_TYPE (stack_save_decl),
+				 stack_save_decl));
+
+      /* Save stack pointer.  */
+      tree call = builtin_decl_implicit (BUILT_IN_STACK_SAVE);
+      call = build_call_expr_loc (UNKNOWN_LOCATION, call, 0);
+      a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node,
+				 stack_save_decl, call));
+    }
+
+  /* Push a new range.  */
+  a68_push_range (clause_mode);
+  current_range->save_restore_stack = save_restore_stack;
+
+  /* Create a decl for clause_result with the right type and add it to the
+     block's declaration list.  */
+  tree clause_result_decl = build_decl (UNKNOWN_LOCATION,
+					VAR_DECL,
+					NULL, /* Set below.  */
+					clause_type);
+  char *clause_result_name = xasprintf ("clause_result%d%%", DECL_UID (clause_result_decl));
+  DECL_NAME (clause_result_decl) = get_identifier (clause_result_name);
+  free (clause_result_name);
+  DECL_INITIAL (clause_result_decl) = a68_get_skip_tree (clause_mode);
+  DECL_CONTEXT (clause_result_decl) = current_range->context;
+  current_range->clause_result_decl = clause_result_decl;
+
+  /* Create a decl for the clause's exit label.  */
+  tree clause_exit_label_decl = build_decl (UNKNOWN_LOCATION,
+					    LABEL_DECL,
+					    NULL, /* Set below.  */
+					    void_type_node);
+  char *exit_label_name = xasprintf ("clause_exit_label%d%%", DECL_UID (clause_exit_label_decl));
+  DECL_NAME (clause_exit_label_decl) = get_identifier (exit_label_name);
+  free (exit_label_name);
+  DECL_CONTEXT (clause_exit_label_decl) = current_range->context;
+  current_range->clause_exit_label_decl = clause_exit_label_decl;
+}
+
+/* Pop a range for a serial clause and return the resulting bind
+   expression.  */
+
+tree
+a68_pop_serial_clause_range (void)
+{
+  struct range *range = current_range;
+  MOID_T *clause_mode = range->mode;
+  tree clause_type = CTYPE (clause_mode);
+
+  /* The last expression in the statements list is either a single unit or a
+     labeled unit.  Consolidate it to a ref if required by the mode of the
+     serial clause.  */
+  {
+    tree_stmt_iterator si = tsi_last (range->stmt_list);
+    tree last_expr = tsi_stmt (si);
+    if (TREE_CODE (last_expr) == COMPOUND_EXPR
+	&& TREE_CODE (TREE_OPERAND (last_expr, 0)) == LABEL_EXPR)
+      {
+	TREE_OPERAND (last_expr, 1) = a68_consolidate_ref (range->mode,
+							   TREE_OPERAND (last_expr, 1));
+	TREE_TYPE (last_expr) = TREE_TYPE (TREE_OPERAND (last_expr, 1));
+      }
+    else
+      last_expr = a68_consolidate_ref (range->mode, last_expr);
+    a68_add_stmt (last_expr);
+    tsi_delink (&si);
+  }
+
+  /* If the serial clause has completers, we have to make use of the
+     clause_result% and clause_exit_label% mechanism to assure the statements
+     list has a single exit at the end.  */
+  if (range->has_completers)
+    {
+      /* First prepend EXPR_DECL expressions for clause_result% and
+	 clause_exit_label% */
+      {
+	tree_stmt_iterator si = tsi_start (range->stmt_list);
+	tsi_link_before (&si,
+			 fold_build1 (DECL_EXPR,
+				      TREE_TYPE (range->clause_result_decl),
+				      range->clause_result_decl),
+			 TSI_CONTINUE_LINKING);
+	tsi_link_before (&si,
+			 fold_build1 (DECL_EXPR,
+				      TREE_TYPE (range->clause_exit_label_decl),
+				      range->clause_exit_label_decl),
+			 TSI_CONTINUE_LINKING);
+      }
+
+      /* Then turn the last expression in stmt_list to an assignment to
+	 clause_result_decl%, but don't bother if it has been voided.  */
+      if (clause_type != a68_void_type)
+	{
+	  tree_stmt_iterator si = tsi_last (range->stmt_list);
+	  tree last_expr = tsi_stmt (si);
+
+	  a68_add_stmt (build2 (MODIFY_EXPR,
+				clause_type,
+				range->clause_result_decl,
+				last_expr));
+	  tsi_delink (&si);
+	}
+
+      a68_add_decl (range->clause_result_decl);
+      a68_add_decl (range->clause_exit_label_decl);
+
+      /* Finally append the exit label and last expression with
+	 result_decl.  */
+      a68_add_stmt (build1 (LABEL_EXPR, void_type_node, range->clause_exit_label_decl));
+      a68_add_stmt (build1 (NON_LVALUE_EXPR, clause_type, range->clause_result_decl));
+    }
+
+  /* Check that the type of the last statement in the statements list is the
+     same than the type corresponding to the clause mode.  */
+  {
+    tree_stmt_iterator si = tsi_last (range->stmt_list);
+    if (TREE_TYPE (tsi_stmt (si)) != clause_type
+	/* But NIL can appear in a context expecting VOID with no widening.  */
+	&& !(clause_type == a68_void_type
+	     && POINTER_TYPE_P (TREE_TYPE (tsi_stmt (si)))
+	     && TREE_CODE (tsi_stmt (si)) == INTEGER_CST
+	     && tree_to_shwi (tsi_stmt (si)) == 0)
+	/* And any row type is valid when M_ROWS is expected.  */
+	&& !(A68_ROWS_TYPE_P (clause_type)
+	     && A68_ROWS_TYPE_P (TREE_TYPE (tsi_stmt (si))))
+	/* Do not rely on comparing pointer types, as the equality fails in
+	   that case.  We need a better way of comparing types, either using
+	   TYPE_CANONICAL or caching.  */
+	&& !(POINTER_TYPE_P (TREE_TYPE (tsi_stmt (si))) && POINTER_TYPE_P (clause_type)))
+      {
+	printf ("last statement:\n");
+	debug_tree (tsi_stmt (si));
+	printf ("expected type:\n");
+	debug_tree (clause_type);
+	gcc_unreachable ();
+      }
+  }
+
+  /* If the serial clause has declarations that involve dynamic allocation, and
+     the environ it establishes is local, then restore the stack pointer.  */
+  if (range->save_restore_stack)
+    {
+      /* Turn last expression of inner clause into a modify statement.  This
+	 may involve a copy.  This can be omitted if the serial clause yields
+	 void.  */
+      if (clause_type != a68_void_type)
+	{
+	  tree_stmt_iterator si = tsi_last (range->stmt_list);
+	  tree last_expr = tsi_stmt (si);
+
+	  a68_add_stmt (build2 (MODIFY_EXPR,
+				clause_type,
+				range->next->clause_result_decl,
+				a68_low_dup (last_expr)));
+	  tsi_delink (&si);
+	}
+
+      /* Finish inner clause, restoring stack pointer on finalizing.  */
+      tree restore_sp = builtin_decl_implicit (BUILT_IN_STACK_RESTORE);
+      restore_sp = build_call_expr_loc (UNKNOWN_LOCATION, restore_sp, 1,
+					current_range->next->clause_stack_save_decl);
+      a68_add_stmt (a68_pop_range_with_finalizer (restore_sp));
+      /* The result value is now in clause_result_decl.  */
+      a68_add_stmt (build1 (NON_LVALUE_EXPR, clause_type,
+			    current_range->clause_result_decl));
+    }
+
+  return a68_pop_range ();
+}
+
+/* Whether the current range is the global range.  */
+
+bool
+a68_in_global_range (void)
+{
+  return current_range == global_range;
+}
+
+/* Initialize ranges.  */
+
+void
+a68_init_ranges (void)
+{
+  global_range = new_range ();
+  global_range->context = build_translation_unit_decl (NULL);
+  current_range = global_range;
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-reals.cc
@@ -0,0 +1,620 @@
+/* Lowering routines for all things related to REAL values.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "math.h" /* For log10 */
+
+#include "a68.h"
+
+tree
+a68_get_real_skip_tree (MOID_T *m)
+{
+  tree int_type = NULL_TREE;
+  tree real_type = NULL_TREE;
+
+  if (m == M_REAL)
+    {
+      int_type = a68_int_type;
+      real_type = a68_real_type;
+    }
+  else if (m == M_LONG_REAL)
+    {
+      int_type = a68_long_int_type;
+      real_type = a68_long_real_type;
+    }
+  else if (m == M_LONG_LONG_REAL)
+    {
+      int_type = a68_long_long_int_type;
+      real_type = a68_long_long_real_type;
+    }
+  else
+    gcc_unreachable ();
+
+  return build_real_from_int_cst (real_type,
+				  build_int_cst (int_type, 0));
+}
+
+static tree
+addr_of_builtin_decl (enum built_in_function fncode)
+{
+  tree builtin = builtin_decl_explicit (fncode);
+  return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (builtin)), builtin);
+}
+
+/* Build PI for the given real type.  */
+
+tree
+a68_real_pi (tree type)
+{
+  return build_real (type, dconst_pi ());
+}
+
+/* Given a real type, build the maximum value expresssable with that type.  */
+
+tree
+a68_real_maxval (tree type)
+{
+  REAL_VALUE_TYPE max;
+  real_maxval (&max, 0, TYPE_MODE (type));
+  return build_real (type, max);
+}
+
+/* Given a real type, build the minimum value expressable with that type.  */
+
+tree
+a68_real_minval (tree type)
+{
+  REAL_VALUE_TYPE min;
+  real_maxval (&min, 1, TYPE_MODE (type));
+  return build_real (type, min);
+}
+
+/* Given a real type, build the smallest value which can be meaningfully added
+   to or substracted from 1.  */
+
+tree
+a68_real_smallval (tree type)
+{
+  /* The smallest real value which can be meaningfully added to or subtracted
+     from 1.  */
+  const machine_mode mode = TYPE_MODE (type);
+  const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+
+  char buf[128];
+  if (fmt->pnan < fmt->p)
+    snprintf (buf, sizeof (buf), "0x1p%d", fmt->emin - fmt->p);
+  else
+    snprintf (buf, sizeof (buf), "0x1p%d", 1 - fmt->p);
+
+  REAL_VALUE_TYPE res;
+  real_from_string (&res, buf);
+  return build_real (type, res);
+}
+
+/* Given a real type, build an INT with the number of decimal digits required
+   to represent a mantissa, such that a real is not reglected in comparison
+   with 1, not including sign.  */
+
+tree
+a68_real_width (tree type)
+{
+  const machine_mode mode = TYPE_MODE (type);
+  const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+  return build_int_cst (a68_int_type, fmt->p);
+}
+
+/* Given a real type, build an INT with the number of decimal digits required
+   to represent a decimal exponent, such that a real can be correctly
+   represented, not including sign.  */
+
+tree
+a68_real_exp_width (tree type ATTRIBUTE_UNUSED)
+{
+  const 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 max_10_exp = fmt->emax * log10_b;
+
+  return build_int_cst (a68_int_type, 1 + log10 (max_10_exp));
+}
+
+/* Given a real value VAL, return -1 if it is less than zero, 0 if it is zero
+   and +1 if it is bigger than zero.  The built value is always of mode
+   M_INT.  */
+
+tree
+a68_real_sign (tree val)
+{
+  tree zero = build_real (TREE_TYPE (val), dconst0);
+  return fold_build3 (COND_EXPR,
+		      a68_int_type,
+		      build2 (EQ_EXPR, integer_type_node, val, zero),
+		      build_int_cst (a68_int_type, 0),
+		      fold_build3 (COND_EXPR,
+				   a68_int_type,
+				   fold_build2 (GT_EXPR, integer_type_node, val, zero),
+				   build_int_cst (a68_int_type, 1),
+				   build_int_cst (a68_int_type, -1)));
+}
+
+/* Absolute value of a real value.  */
+
+tree
+a68_real_abs (tree val)
+{
+  return fold_build1 (ABS_EXPR, TREE_TYPE (val), val);
+}
+
+tree
+a68_real_sqrt (tree type)
+{
+  enum built_in_function builtin;
+
+  if (type == float_type_node)
+    builtin = BUILT_IN_SQRTF;
+  else if (type == double_type_node)
+    builtin = BUILT_IN_SQRT;
+  else if (type == long_double_type_node)
+    builtin = BUILT_IN_SQRTL;
+  else
+    gcc_unreachable ();
+
+  return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_tan (tree type)
+{
+  enum built_in_function builtin;
+
+  if (type == float_type_node)
+    builtin = BUILT_IN_TANF;
+  else if (type == double_type_node)
+    builtin = BUILT_IN_TAN;
+  else if (type == long_double_type_node)
+    builtin = BUILT_IN_TANL;
+  else
+    gcc_unreachable ();
+
+  return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_sin (tree type)
+{
+  enum built_in_function builtin;
+
+  if (type == float_type_node)
+    builtin = BUILT_IN_SINF;
+  else if (type == double_type_node)
+    builtin = BUILT_IN_SIN;
+  else if (type == long_double_type_node)
+    builtin = BUILT_IN_SINL;
+  else
+    gcc_unreachable ();
+
+  return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_cos (tree type)
+{
+  enum built_in_function builtin;
+
+  if (type == float_type_node)
+    builtin = BUILT_IN_COSF;
+  else if (type == double_type_node)
+    builtin = BUILT_IN_COS;
+  else if (type == long_double_type_node)
+    builtin = BUILT_IN_COSL;
+  else
+    gcc_unreachable ();
+
+  return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_acos (tree type)
+{
+  enum built_in_function builtin;
+
+  if (type == float_type_node)
+    builtin = BUILT_IN_ACOSF;
+  else if (type == double_type_node)
+    builtin = BUILT_IN_ACOS;
+  else if (type == long_double_type_node)
+    builtin = BUILT_IN_ACOSL;
+  else
+    gcc_unreachable ();
+
+  return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_asin (tree type)
+{
+  enum built_in_function builtin;
+
+  if (type == float_type_node)
+    builtin = BUILT_IN_ASINF;
+  else if (type == double_type_node)
+    builtin = BUILT_IN_ASIN;
+  else if (type == long_double_type_node)
+    builtin = BUILT_IN_ASINL;
+  else
+    gcc_unreachable ();
+
+  return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_atan (tree type)
+{
+  enum built_in_function builtin;
+
+  if (type == float_type_node)
+    builtin = BUILT_IN_ATANF;
+  else if (type == double_type_node)
+    builtin = BUILT_IN_ATAN;
+  else if (type == long_double_type_node)
+    builtin = BUILT_IN_ATANL;
+  else
+    gcc_unreachable ();
+
+  return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_ln (tree type)
+{
+  enum built_in_function builtin;
+
+  if (type == float_type_node)
+    builtin = BUILT_IN_LOGF;
+  else if (type == double_type_node)
+    builtin = BUILT_IN_LOG;
+  else if (type == long_double_type_node)
+    builtin = BUILT_IN_LOGL;
+  else
+    gcc_unreachable ();
+
+  return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_log (tree type)
+{
+  enum built_in_function builtin;
+
+  if (type == float_type_node)
+    builtin = BUILT_IN_LOG10F;
+  else if (type == double_type_node)
+    builtin = BUILT_IN_LOG10;
+  else if (type == long_double_type_node)
+    builtin = BUILT_IN_LOG10L;
+  else
+    gcc_unreachable ();
+
+  return addr_of_builtin_decl (builtin);
+}
+
+tree
+a68_real_exp (tree type)
+{
+  enum built_in_function builtin;
+
+  if (type == float_type_node)
+    builtin = BUILT_IN_EXPF;
+  else if (type == double_type_node)
+    builtin = BUILT_IN_EXP;
+  else if (type == long_double_type_node)
+    builtin = BUILT_IN_EXPL;
+  else
+    gcc_unreachable ();
+
+  return addr_of_builtin_decl (builtin);
+}
+
+/* Build the real value lengthened from the value of VAL, from mode
+   FROM_MODE to mode TO_MODE.  */
+
+tree
+a68_real_leng (MOID_T *to_mode, MOID_T *from_mode ATTRIBUTE_UNUSED, tree val)
+{
+  /* Lengthening can be done by just a conversion.  */
+  return fold_convert (CTYPE (to_mode), val);
+}
+
+/* Build the real value that can be lengthened to the value of VAL, from mode
+   FROM_MODE to mode TO_MODE.
+
+   If VAL cannot be represented in TO_MODE because it is bigger than the most
+   positive value representable in TO_MODE, then it is truncated to that value.
+
+   Likewise, if VAL cannot be represented in TO_MODE because it is less than
+   the most negative value representable in TO_MODE, then it is truncated to
+   that value.  */
+
+tree
+a68_real_shorten (MOID_T *to_mode, MOID_T *from_mode ATTRIBUTE_UNUSED, tree val)
+{
+  tree most_positive_value = fold_convert (CTYPE (from_mode),
+					   a68_real_maxval (CTYPE (to_mode)));
+  tree most_negative_value = fold_convert (CTYPE (from_mode),
+					   a68_real_minval (CTYPE (to_mode)));
+
+  val = save_expr (val);
+  most_positive_value = save_expr (most_positive_value);
+  most_negative_value = save_expr (most_negative_value);
+  return fold_build3 (COND_EXPR, CTYPE (to_mode),
+		      fold_build2 (GT_EXPR, a68_bool_type, val, most_positive_value),
+		      fold_convert (CTYPE (to_mode), most_positive_value),
+		      fold_build3 (COND_EXPR, CTYPE (to_mode),
+				   fold_build2 (LT_EXPR, a68_bool_type, val, most_negative_value),
+				   fold_convert (CTYPE (to_mode), most_negative_value),
+				   fold_convert (CTYPE (to_mode), val)));
+}
+
+/* Given a real expression VAL of mode MODE, produce an integral value which is
+   equal to the given real, or the next integer below (more negative than) the
+   given real.  */
+
+tree
+a68_real_entier (tree val, MOID_T *to_mode, MOID_T *from_mode)
+{
+  tree fn = NULL_TREE;
+  tree to_type = CTYPE (to_mode);
+
+  if (from_mode == M_REAL)
+    {
+      if (to_type == integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_IFLOORF);
+      else if (to_type == long_integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_LFLOORF);
+      else if (to_type == long_long_integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_LLFLOORF);
+      else
+	gcc_unreachable ();
+    }
+  else if (from_mode == M_LONG_REAL)
+    {
+      if (to_type == integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_IFLOOR);
+      else if (to_type == long_integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_LFLOOR);
+      else if (to_type == long_long_integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_LLFLOOR);
+      else
+	gcc_unreachable ();
+    }
+  else if (from_mode == M_LONG_LONG_REAL)
+    {
+      if (to_type == integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_IFLOORL);
+      else if (to_type == long_integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_LFLOORL);
+      else if (to_type == long_long_integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_LLFLOORL);
+      else
+	gcc_unreachable ();
+    }
+  else
+    gcc_unreachable ();
+
+  return build_call_expr_loc (UNKNOWN_LOCATION, fn, 1, val);
+}
+
+/* Given a real expression VAL of mode MODE, produce an integral value which is
+   the nearest integer to the given real.  */
+
+tree
+a68_real_round (tree val, MOID_T *to_mode, MOID_T *from_mode)
+{
+  tree fn = NULL_TREE;
+  tree to_type = CTYPE (to_mode);
+
+  if (from_mode == M_REAL)
+    {
+      if (to_type == integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_IROUNDF);
+      else if (to_type == long_integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_LROUNDF);
+      else if (to_type == long_long_integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_LLROUNDF);
+      else
+	gcc_unreachable ();
+    }
+  else if (from_mode == M_LONG_REAL)
+    {
+      if (to_type == integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_IROUND);
+      else if (to_type == long_integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_LROUND);
+      else if (to_type == long_long_integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_LLROUND);
+      else
+	gcc_unreachable ();
+    }
+  else if (from_mode == M_LONG_LONG_REAL)
+    {
+      if (to_type == integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_IROUNDL);
+      else if (to_type == long_integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_LROUNDL);
+      else if (to_type == long_long_integer_type_node)
+	fn = builtin_decl_explicit (BUILT_IN_LLROUNDL);
+      else
+	gcc_unreachable ();
+    }
+  else
+    gcc_unreachable ();
+
+  return build_call_expr_loc (UNKNOWN_LOCATION, fn, 1, val);
+}
+
+
+/* Given two real values of mode M, build an expression that calculates the
+   addition of A and B.  */
+
+tree
+a68_real_plus (MOID_T *m, tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, PLUS_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates the
+   subtraction of A by B.  */
+
+tree
+a68_real_minus (MOID_T *m, tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, MINUS_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates the
+   multiplication of A by B.  */
+
+tree
+a68_real_mult (MOID_T *m, tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, MULT_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates the
+   division of A by B.  */
+
+tree
+a68_real_div (MOID_T *m, tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, RDIV_EXPR, CTYPE (m), a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates whether
+   A = B.  */
+
+tree
+a68_real_eq (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates whether
+   A /= B.  */
+
+tree
+a68_real_ne (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates whether
+   A < B.  */
+
+tree
+a68_real_lt (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, LT_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates
+   whether A <= B.  */
+
+tree
+a68_real_le (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, LE_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates whether
+   A > B.  */
+
+tree
+a68_real_gt (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, GT_EXPR, boolean_type_node, a, b);
+}
+
+/* Given two real values of mode M, build an expression that calculates whether
+   A >= B.  */
+
+tree
+a68_real_ge (tree a, tree b, location_t loc)
+{
+  return fold_build2_loc (loc, GE_EXPR, boolean_type_node, a, b);
+}
+
+/* Exponentiation involving real values.
+
+   REAL <- REAL, REAL
+   REAL <- REAL, INT
+   LONG REAL <- LONG REAL, LONG REAL
+   LONG REAL <- LONG REAL, INT
+   LONG LONG REAL <- LONG LONG REAL, LONG LONG REAL
+   LONG LONG REAL <- LONG LONG REAL, INT  */
+
+tree
+a68_real_pow (MOID_T *m, MOID_T *a_mode, MOID_T *b_mode,
+	      tree a, tree b, location_t loc)
+{
+  enum built_in_function built_in;
+  if (m == M_REAL)
+    {
+      gcc_assert (a_mode == M_REAL);
+      built_in = b_mode == M_REAL ? BUILT_IN_POWF : BUILT_IN_POWIF;
+    }
+  else if (m == M_LONG_REAL)
+    {
+      gcc_assert (a_mode == M_LONG_REAL);
+      built_in = b_mode == M_LONG_REAL ? BUILT_IN_POW : BUILT_IN_POWI;
+    }
+  else if (m == M_LONG_LONG_REAL)
+    {
+      gcc_assert (a_mode == M_LONG_LONG_REAL);
+      built_in = b_mode == M_LONG_LONG_REAL ? BUILT_IN_POWL : BUILT_IN_POWIL;
+    }
+  else
+    gcc_unreachable ();
+
+  tree call = builtin_decl_explicit (built_in);
+  gcc_assert (call != NULL_TREE);
+  return build_call_expr_loc (loc, call, 2, a, b);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-refs.cc
@@ -0,0 +1,52 @@
+/* Lowering routines for all things related to names.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielding of SKIP for the given name mode.  */
+
+tree
+a68_get_ref_skip_tree (MOID_T *m)
+{
+  /* Build a NULL pointer.  */
+  return build_int_cst (CTYPE (m), 0);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-runtime.cc
@@ -0,0 +1,225 @@
+/* Libcalls to Algol 68 run-time functions.
+   Copyright (C) 2006-2025 Free Software Foundation, Inc.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+   Adapted from gcc/d/runtime.cc.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* The lowering pass may generate expressions to call various runtime library
+   functions.  Most of these functions are implemented in libga68.  This file
+   provides facilities to compile libcalls to runtime functions.  The file
+   a68-low-runtime.def contains a database of available runtime library
+   functions.  */
+
+enum a68_libcall_type
+{
+  LCT_VOID,
+  LCT_CHAR,
+  LCT_CONSTCHARPTR,
+  LCT_VOIDPTR,
+  LCT_UNISTR,
+  LCT_UNISTRPTR,
+  LCT_SIZE,
+  LCT_SSIZE,
+  LCT_SIZEPTR,
+  LCT_UINT,
+  LCT_INT,
+  LCT_LONGLONGINT,
+  LCT_FLOAT,
+  LCT_DOUBLE,
+  LCT_LONGDOUBLE,
+  LCT_END
+};
+
+/* An array of all types that are used by the runtime functions we need.  */
+
+static tree libcall_types[LCT_END];
+
+/* Internal list of library functions.  */
+
+static tree libcall_decls[A68_LIBCALL_LAST];
+
+/* Return the TREE type that is described by TYPE.  */
+
+static tree
+get_libcall_type (a68_libcall_type type)
+{
+  if (libcall_types[type])
+    return libcall_types[type];
+
+  if (type == LCT_VOID)
+    libcall_types[type] = void_type_node;
+  else if (type == LCT_CHAR)
+    libcall_types[type] = uint32_type_node;
+  else if (type == LCT_CONSTCHARPTR)
+    libcall_types[type] = build_pointer_type (build_qualified_type (char_type_node,
+								    TYPE_QUAL_CONST));
+  else if (type == LCT_VOIDPTR)
+    libcall_types[type] = ptr_type_node;
+  else if (type == LCT_UNISTR)
+    libcall_types[type] = build_pointer_type (a68_char_type);
+  else if (type == LCT_UNISTRPTR)
+    libcall_types[type] = build_pointer_type (build_pointer_type (a68_char_type));
+  else if (type == LCT_SIZE)
+    libcall_types[type] = sizetype;
+  else if (type == LCT_SSIZE)
+    libcall_types[type] = ssizetype;
+  else if (type == LCT_SIZEPTR)
+    libcall_types[type] = build_pointer_type (sizetype);
+  else if (type == LCT_UINT)
+    libcall_types[type] = unsigned_type_node;
+  else if (type == LCT_INT)
+    libcall_types[type] = integer_type_node;
+  else if (type == LCT_LONGLONGINT)
+    libcall_types[type] = long_long_integer_type_node;
+  else if (type == LCT_FLOAT)
+    libcall_types[type] = float_type_node;
+  else if (type == LCT_DOUBLE)
+    libcall_types[type] = double_type_node;
+  else if (type == LCT_LONGDOUBLE)
+    libcall_types[type] = long_double_type_node;
+  else
+    gcc_unreachable ();
+
+  return libcall_types[type];
+}
+
+/* Build and return a function declaration named NAME.  The RETURN_TYPE is the
+   type returned, FLAGS are the expression call flags, and NPARAMS is the
+   number of arguments, the types of which are provided in `...'.  */
+
+static tree
+build_libcall_decl (const char *name, a68_libcall_type return_type,
+		    int flags, int nparams, ...)
+{
+  tree *args = XALLOCAVEC (tree, nparams);
+  bool varargs = false;
+  tree fntype;
+
+  /* Add parameter types, using `void' as the last parameter type
+     to mean this function accepts a variable list of arguments.  */
+  va_list ap;
+  va_start (ap, nparams);
+
+  for (int i = 0; i < nparams; i++)
+    {
+      a68_libcall_type ptype = (a68_libcall_type) va_arg (ap, int);
+      tree type = get_libcall_type (ptype);
+
+      if (type == void_type_node)
+	{
+	  varargs = true;
+	  nparams = i;
+	}
+      else
+	args[i] = type;
+    }
+
+  va_end (ap);
+
+  /* Build the function.  */
+  tree tret = get_libcall_type (return_type);
+  if (varargs)
+    fntype = build_varargs_function_type_array (tret, nparams, args);
+  else
+    fntype = build_function_type_array (tret, nparams, args);
+
+  tree decl = build_decl (UNKNOWN_LOCATION, FUNCTION_DECL,
+			  get_identifier (name), fntype);
+  DECL_EXTERNAL (decl) = 1;
+  TREE_PUBLIC (decl) = 1;
+  DECL_ARTIFICIAL (decl) = 1;
+  DECL_VISIBILITY (decl) = VISIBILITY_DEFAULT;
+  DECL_VISIBILITY_SPECIFIED (decl) = 1;
+
+  /* Set any attributes on the function, such as malloc or noreturn.  */
+  set_call_expr_flags (decl, flags);
+  return decl;
+}
+
+/* Return or create the runtime library function declaration for LIBCALL.
+   Library functions are generated as needed.  This could probably be changed
+   in the future to be done in the compiler init stage, like GCC builtin trees
+   are.  */
+
+tree
+a68_get_libcall (a68_libcall_fn libcall)
+{
+  if (libcall_decls[libcall])
+    return libcall_decls[libcall];
+
+  switch (libcall)
+    {
+#define DEF_A68_RUNTIME(CODE, NAME, TYPE, PARAMS, FLAGS) \
+    case A68_LIBCALL_ ## CODE:	\
+      libcall_decls[libcall] = build_libcall_decl (NAME, TYPE, FLAGS, PARAMS); \
+      break;
+#include "a68-low-runtime.def"
+#undef DEF_A68_RUNTIME
+    default:
+      gcc_unreachable ();
+    }
+
+  return libcall_decls[libcall];
+}
+
+/* Generate a call to LIBCALL, returning the result as TYPE.  NARGS is the
+   number of call arguments, the expressions of which are provided in `...'.
+   This does not perform conversions or promotions on the arguments.  */
+
+tree
+a68_build_libcall (a68_libcall_fn libcall, tree type ATTRIBUTE_UNUSED,
+		   int nargs, ...)
+{
+  /* Build the call expression to the runtime function.  */
+  tree decl = a68_get_libcall (libcall);
+  tree *args = XALLOCAVEC (tree, nargs);
+  va_list ap;
+
+  va_start (ap, nargs);
+  for (int i = 0; i < nargs; i++)
+    args[i] = va_arg (ap, tree);
+  va_end (ap);
+
+  tree result = build_call_expr_loc_array (input_location, decl, nargs, args);
+
+  /* Assumes caller knows what it is doing.  */
+  return result;
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-runtime.def
@@ -0,0 +1,91 @@
+/* a68-low-runtime.def -- Definitions for Algol 68 runtime functions.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+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/>.  */
+
+/* Helper macros for parameter building.  */
+#define P0()	0
+#define P1(T1)	1, LCT_ ## T1
+#define P2(T1, T2) \
+		2, LCT_ ## T1, LCT_ ## T2
+#define P3(T1, T2, T3) \
+		3, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3
+#define P4(T1, T2, T3, T4) \
+		4, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3, LCT_ ## T4
+#define P5(T1, T2, T3, T4, T5)  \
+		5, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3, LCT_ ## T4, LCT_ ## T5
+#define P6(T1, T2, T3, T4, T5, T6)  \
+		6, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3, LCT_ ## T4, LCT_ ## T5, LCT_ ## T6
+#define P7(T1, T2, T3, T4, T5, T6, T7)					\
+                7, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3, LCT_ ## T4, LCT_ ## T5, LCT_ ## T6, LCT_ ## T7
+#define RT(T1)	LCT_ ## T1
+
+/* Algol 68 runtime library functions.  */
+
+/* DEF_A68_RUNTIME (CODE, NAME, TYPE, PARAMS, FLAGS)
+   CODE	    The enum code used to refer to this function.
+   NAME	    The name of this function as a string.
+   FLAGS    ECF flags to describe attributes of the function.
+
+   Used for declaring functions that are called by generated code.  */
+
+DEF_A68_RUNTIME (ASSERT, "_libga68_assert", RT(VOID), P2(CONSTCHARPTR, UINT), ECF_NORETURN)
+DEF_A68_RUNTIME (SET_EXIT_STATUS, "_libga68_set_exit_status", RT(VOID), P1(INT), 0)
+DEF_A68_RUNTIME (MALLOC, "_libga68_malloc", RT(VOIDPTR), P1(SIZE), ECF_NOTHROW | ECF_LEAF | ECF_MALLOC)
+DEF_A68_RUNTIME (DEREFNIL, "_libga68_derefnil", RT(VOID), P2(CONSTCHARPTR, UINT), ECF_NORETURN)
+DEF_A68_RUNTIME (UNREACHABLE, "_libga68_unreachable", RT(VOID), P2(CONSTCHARPTR, UINT), ECF_NORETURN)
+DEF_A68_RUNTIME (INVALIDCHARERROR, "_libga68_invalidcharerror", RT(VOID), P3(CONSTCHARPTR,UINT,INT), ECF_NORETURN)
+DEF_A68_RUNTIME (BITSBOUNDSERROR, "_libga68_bitsboundserror", RT(VOID), P3(CONSTCHARPTR,UINT,SSIZE), ECF_NORETURN)
+DEF_A68_RUNTIME (ARRAYLOWERBOUND, "_libga68_lower_bound", RT(VOID),
+		 P4(CONSTCHARPTR, UINT, SSIZE, SSIZE), ECF_NORETURN)
+DEF_A68_RUNTIME (ARRAYUPPERBOUND, "_libga68_upper_bound", RT(VOID),
+		 P4(CONSTCHARPTR, UINT, SSIZE, SSIZE), ECF_NORETURN)
+DEF_A68_RUNTIME (ARRAYBOUNDS, "_libga68_bounds", RT(VOID),
+		 P5(CONSTCHARPTR, UINT, SSIZE, SSIZE, SSIZE), ECF_NORETURN)
+DEF_A68_RUNTIME (ARRAYBOUNDSMISMATCH, "_libga68_bounds_mismatch", RT(VOID),
+		 P7(CONSTCHARPTR, UINT, SIZE, SSIZE, SSIZE, SSIZE, SSIZE), ECF_NORETURN)
+DEF_A68_RUNTIME (ARRAYDIM, "_libga68_dim", RT(VOID),
+                 P4(CONSTCHARPTR, UINT, SIZE, SIZE), ECF_NORETURN)
+DEF_A68_RUNTIME (RANDOM, "_libga68_random", RT(FLOAT), P0(), 0)
+DEF_A68_RUNTIME (LONGRANDOM, "_libga68_longrandom", RT(DOUBLE), P0(), 0)
+DEF_A68_RUNTIME (LONGLONGRANDOM, "_libga68_longlongrandom", RT(LONGDOUBLE), P0(), 0)
+DEF_A68_RUNTIME (POSIX_FCONNECT, "_libga68_posixfconnect", RT(INT), P4(UNISTRPTR,SIZE,SIZE,INT), 0)
+DEF_A68_RUNTIME (POSIX_FOPEN, "_libga68_posixfopen", RT(INT), P4(UNISTRPTR,SIZE,SIZE,UINT), 0)
+DEF_A68_RUNTIME (POSIX_FCREATE, "_libga68_posixcreat", RT(INT), P4(UNISTRPTR,SIZE,SIZE,UINT), 0)
+DEF_A68_RUNTIME (POSIX_FCLOSE, "_libga68_posixclose", RT(INT), P0(), 0)
+DEF_A68_RUNTIME (POSIX_FSIZE, "_libga68_posixfsize", RT(LONGLONGINT), P1(INT), 0)
+DEF_A68_RUNTIME (POSIX_ARGC, "_libga68_posixargc", RT(INT), P0(), 0)
+DEF_A68_RUNTIME (POSIX_ARGV, "_libga68_posixargv", RT(UNISTRPTR), P2(INT, SIZEPTR), 0)
+DEF_A68_RUNTIME (POSIX_PUTCHAR, "_libga68_posixputchar", RT(CHAR), P1(CHAR), 0)
+DEF_A68_RUNTIME (POSIX_FPUTC, "_libga68_posixfputc", RT(CHAR), P2(INT,CHAR), 0)
+DEF_A68_RUNTIME (POSIX_PUTS, "_libga68_posixputs", RT(VOID), P3(UNISTR,SIZE,SIZE), 0)
+DEF_A68_RUNTIME (POSIX_FPUTS, "_libga68_posixfputs", RT(INT), P4(INT,UNISTRPTR,SIZE,SIZE), 0)
+DEF_A68_RUNTIME (POSIX_GETCHAR, "_libga68_posixgetchar", RT(CHAR), P0(), 0)
+DEF_A68_RUNTIME (POSIX_FGETC, "_libga68_posixfgetc", RT(CHAR), P1(INT), 0)
+DEF_A68_RUNTIME (POSIX_GETS, "_libga68_posixgets", RT(UNISTRPTR), P2(INT,SIZEPTR), 0)
+DEF_A68_RUNTIME (POSIX_FGETS, "_libga68_posixfgets", RT(UNISTRPTR), P3(INT,INT,SIZEPTR), 0)
+DEF_A68_RUNTIME (POSIX_GETENV, "_libga68_posixgetenv", RT(VOID), P5(UNISTR,SIZE,SIZE,UNISTRPTR,SIZEPTR), 0)
+DEF_A68_RUNTIME (POSIX_ERRNO, "_libga68_posixerrno", RT(INT), P0(), 0)
+DEF_A68_RUNTIME (POSIX_PERROR, "_libga68_posixperror", RT(VOID), P3(UNISTR,SIZE,SIZE), 0)
+DEF_A68_RUNTIME (POSIX_STRERROR, "_libga68_posixstrerror", RT(UNISTRPTR), P2(INT, SIZEPTR), 0)
+DEF_A68_RUNTIME (U32_CMP2, "_libga68_u32_cmp2", RT(INT), P6(UNISTR, SIZE, SIZE, UNISTR, SIZE, SIZE), 0)
+
+#undef P0
+#undef P1
+#undef P2
+#undef P3
+#undef P4
+#undef P5
+#undef RT
--- /dev/null
+++ b/src/gcc/algol68/a68-low-strings.cc
@@ -0,0 +1,390 @@
+/* Lowering routines for all things related to STRINGs.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielding of SKIP for M_STRING.  */
+
+tree
+a68_get_string_skip_tree (void)
+{
+  return a68_get_multiple_skip_tree (M_FLEX_ROW_CHAR);
+}
+
+/* Copy chars from STR to ELEMENTS starting at TO_INDEX chars in ELEMENTS.  */
+
+static void
+copy_string (tree elements, tree to_index, tree str)
+{
+  tree char_pointer_type = build_pointer_type (a68_char_type);
+  tree num_elems
+    = a68_lower_tmpvar ("num_elems%", sizetype, a68_multiple_num_elems (str));
+
+  tree from_index
+    = a68_lower_tmpvar ("from_index%", sizetype, size_zero_node);
+  tree from_offset
+    = a68_lower_tmpvar ("from_offset%", sizetype, size_zero_node);
+
+  /* Begin of loop body.  */
+  a68_push_range (NULL);
+  {
+    /* if (from_index == num_elems) break;  */
+    a68_add_stmt (fold_build1 (EXIT_EXPR, void_type_node,
+			       fold_build2 (GE_EXPR, sizetype,
+					    from_index, num_elems)));
+
+    /* *(elements + to_index) = *(elements + from_index)  */
+    tree to_offset = fold_build2 (MULT_EXPR, sizetype,
+				  to_index, size_in_bytes (a68_char_type));
+    a68_add_stmt (fold_build2 (MODIFY_EXPR,
+			       void_type_node,
+			       fold_build2 (MEM_REF, a68_char_type,
+					    fold_build2 (POINTER_PLUS_EXPR,
+							 char_pointer_type,
+							 elements, to_offset),
+					    fold_convert (char_pointer_type,
+							  integer_zero_node)),
+			       fold_build2 (MEM_REF, a68_char_type,
+					    fold_build2 (POINTER_PLUS_EXPR,
+							 char_pointer_type,
+							 a68_multiple_elements (str),
+							 from_offset),
+					    fold_convert (char_pointer_type,
+							  integer_zero_node))));
+
+    /* from_offset = from_offset + stride */
+    a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node,
+			       from_offset,
+			       fold_build2 (PLUS_EXPR, sizetype,
+					    from_offset,
+					    a68_multiple_stride (str, size_zero_node))));
+    /* to_index = to_index + 1 */
+    a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, sizetype, to_index, size_one_node));
+
+    /* from_index = from_index + 1 */
+    a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, sizetype, from_index, size_one_node));
+  }  
+
+  /* End of loop body.  */
+  tree loop_body = a68_pop_range ();
+  a68_add_stmt (fold_build1 (LOOP_EXPR,
+			     void_type_node,
+			     loop_body));
+}
+
+/* Given two STRINGs STR1 and STR2, allocate a new string on the stack with a
+   copy of the concatenated characters of the given string.  */
+
+tree
+a68_string_concat (tree str1, tree str2)
+{
+  tree char_pointer_type = build_pointer_type (a68_char_type);
+  static tree string_concat_fndecl;
+
+  if (string_concat_fndecl == NULL_TREE)
+    {
+      string_concat_fndecl
+	= a68_low_toplevel_func_decl ("string_concat",
+				      build_function_type_list (char_pointer_type,
+								TREE_TYPE (str1),
+								TREE_TYPE (str2),
+								NULL_TREE));
+      announce_function (string_concat_fndecl);
+
+      tree s1 = a68_low_func_param (string_concat_fndecl, "s1", TREE_TYPE (str1));
+      tree s2 = a68_low_func_param (string_concat_fndecl, "s2", TREE_TYPE (str2));
+      DECL_ARGUMENTS (string_concat_fndecl) = chainon (s1, s2);
+						       
+      a68_push_function_range (string_concat_fndecl, char_pointer_type,
+			       true /* top_level */);
+
+      tree n1 = a68_lower_tmpvar ("n1%", sizetype, a68_multiple_num_elems (s1));
+      tree n2 = a68_lower_tmpvar ("n2%", sizetype, a68_multiple_num_elems (s2));
+      tree num_elems = a68_lower_tmpvar ("num_elems%", sizetype,
+					 fold_build2 (PLUS_EXPR, sizetype, n1, n2));
+
+      /* First allocate memory for the result string.  We need enough space to
+	 hold the elements of both strings with a stride of 1S.  */
+      tree char_pointer_type = build_pointer_type (a68_char_type);
+      tree elements_size = fold_build2 (MULT_EXPR, sizetype,
+					size_in_bytes (a68_char_type),
+					num_elems);
+      tree elements = a68_lower_tmpvar ("elements%", char_pointer_type,
+					a68_lower_malloc (a68_char_type, elements_size));
+
+      /* Copy elements.  */
+      tree to_index = a68_lower_tmpvar ("to_index%", sizetype, size_zero_node);
+      copy_string (elements, to_index, s1);
+      copy_string (elements, to_index, s2);
+      a68_pop_function_range (elements);
+    }
+
+  /* Build the resulting multiple.  */
+  str1 = save_expr (str1);
+  str2 = save_expr (str2);
+  tree n1 = a68_multiple_num_elems (str1);
+  tree n2 = a68_multiple_num_elems (str2);
+  tree num_elems = save_expr (fold_build2 (PLUS_EXPR, sizetype, n1, n2));
+  tree elements_size = fold_build2 (MULT_EXPR, sizetype,
+				    size_in_bytes (a68_char_type),
+				    num_elems);
+  tree lower_bound = ssize_int (1);
+  tree upper_bound = fold_convert (ssizetype, num_elems);
+  tree elements = build_call_nary (char_pointer_type,
+				   fold_build1 (ADDR_EXPR,
+						build_pointer_type (TREE_TYPE (string_concat_fndecl)),
+						string_concat_fndecl),
+				   2, str1, str2);
+  return a68_row_value (CTYPE (M_STRING), 1 /* dim */,
+			elements, elements_size,
+			&lower_bound, &upper_bound);
+}
+
+/* Given a STRING STR and an INT FACTOR, return STRING concatenated to itself
+   FACTOR - 1 times.
+
+   Negative values of FACTOR are interpreted as zero.  */
+
+tree
+a68_string_mult (tree str, tree factor)
+{
+  a68_push_range (M_STRING);
+
+  str = save_expr (str);
+  tree ssize_one_node = ssize_int (1);
+  tree res = a68_lower_tmpvar ("res%", CTYPE (M_STRING), str);
+  tree index = a68_lower_tmpvar ("index%", ssizetype, ssize_one_node);
+
+  /* Begin of loop body.  */
+  a68_push_range (NULL);
+
+  /* if (index == FACTOR) break;  */
+  a68_add_stmt (fold_build1 (EXIT_EXPR,
+			     void_type_node,
+			     fold_build2 (GE_EXPR, ssizetype,
+					  index,
+					  fold_convert (ssizetype, factor))));
+
+  /* res += str */
+  a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (res),
+			     res,
+			     a68_string_concat (res, str)));
+
+  /* index++ */
+  a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR,
+			     ssizetype,
+			     index, ssize_one_node));
+  tree loop_body = a68_pop_range ();
+  /* End of loop body.  */
+  a68_add_stmt (fold_build1 (LOOP_EXPR,
+			     void_type_node,
+			     loop_body));
+  a68_add_stmt (res);
+  return a68_pop_range ();
+}
+
+/* Given a CHAR C, build a string whose contents are just that CHAR.  */
+
+tree
+a68_string_from_char (tree c)
+{
+  tree lower_bound = ssize_int (1);
+  tree upper_bound = lower_bound;
+  tree char_pointer_type = build_pointer_type (a68_char_type);
+
+  a68_push_range (M_STRING);
+
+  tree elements = a68_lower_tmpvar ("elements%", char_pointer_type,
+				    a68_lower_malloc (a68_char_type,
+						      size_one_node));
+  a68_add_stmt (fold_build2 (MODIFY_EXPR,
+			     void_type_node,
+			     fold_build1 (INDIRECT_REF, a68_char_type, elements),
+			     c));
+  a68_add_stmt (a68_row_value (CTYPE (M_STRING), 1 /* dim */,
+			       elements,
+			       size_in_bytes (a68_char_type),
+			       &lower_bound, &upper_bound));
+  return a68_pop_range ();
+}
+
+/* Compare the two given strings lexicographically and return -1 (less than), 0
+   (equal to) or 1 (bigger than) reflecting the result of the comparison.  */
+
+tree
+a68_string_cmp (tree s1, tree s2)
+{
+  s1 = save_expr (s1);
+  tree s1_elems = a68_multiple_elements (s1);
+  tree s1_len = a68_multiple_num_elems (s1);
+  tree s1_stride = a68_multiple_stride (s1, size_zero_node);
+
+  s2 = save_expr (s2);
+  tree s2_elems = a68_multiple_elements (s2);
+  tree s2_len = a68_multiple_num_elems (s2);
+  tree s2_stride = a68_multiple_stride (s2, size_zero_node);
+
+  return a68_build_libcall (A68_LIBCALL_U32_CMP2,
+			    a68_int_type, 6,
+			    s1_elems, s1_len, s1_stride,
+			    s2_elems, s2_len, s2_stride);
+}
+
+/* Return a newly allocated UTF-8 string resulting from processing the string
+   breaks in STR.  This function assumes the passed string is well-formed (the
+   scanner is in charge of seeing that is true) and just ICEs if it is not.  */
+
+char *
+a68_string_process_breaks (const char *str)
+{
+  size_t len = 0;
+  char *res = NULL;
+
+  /* First calculate the size of the resulting string.  */
+  for (const char *p = str; *p != '\0';)
+    {
+      if (*p == '\'')
+	{
+	  switch (p[1])
+	    {
+	    case '\'':
+	    case 'n':
+	    case 'f':
+	    case 'r':
+	    case 't':
+	      len += 1;
+	      p += 2;
+	      break;
+	    case '(':
+	      p += 2;
+	      while (1)
+		{
+		  if (p[0] == ')')
+		    {
+		      p++;
+		      break;
+		    }
+		  else if (p[0] == ',' || ISSPACE (p[0]))
+		    {
+		      p++;
+		      continue;
+		    }
+
+		  /* An Unicode codepoint encoded in UTF-8 occupies at most six
+		     octets.  */
+		  len += 6;
+		  p += (p[1] == 'u' ? 5 : 9);
+		}
+	      break;
+	    default:
+	      gcc_unreachable ();
+	    }
+	}
+      else
+	{
+	  len += 1;
+	  p += 1;
+	}
+    }
+
+  /* Now and allocate it, adding space for a trailing NULL.  */
+  res = (char *) xmalloc (len + 1);
+
+  /* Finally fill it with the result of expanding all the string breaks.  */
+  size_t offset = 0;
+  for (const char *p = str; *p != '\0';)
+    {
+      if (*p == '\'')
+	{
+	  switch (p[1])
+	    {
+	    case '\'': res[offset] = '\''; p += 2; offset += 1; break;
+	    case 'n': res[offset] = '\n'; p += 2;  offset += 1; break;
+	    case 't': res[offset] = '\t'; p += 2;  offset += 1; break;
+	    case 'r': res[offset] = '\r'; p += 2;  offset += 1; break;
+	    case 'f': res[offset] = '\f'; p += 2;  offset += 1; break;
+	    case '(':
+	      {
+		p += 2;
+		while (1)
+		  {
+		    if (p[0] == ')')
+		      {
+			p++;
+			break;
+		      }
+		    else if (p[0] == ',' || ISSPACE (p[0]))
+		      {
+			p++;
+			continue;
+		      }
+
+		    /* Skip the u or U.  */
+		    gcc_assert (p[0] == 'u' || p[0] == 'U');
+		    p++;
+
+		    char *end;
+		    int64_t codepoint = strtol (p, &end, 16);
+		    gcc_assert (end > p);
+		    p = end;
+		    /* Append the UTF-8 encoding of the obtained codepoint to
+		       the `res' string.  */
+		    int n = a68_u8_uctomb ((uint8_t *) res + offset, codepoint, 6);
+		    gcc_assert (n > 0);
+		    offset += n;
+		  }
+		break;
+	      }
+	    default: gcc_unreachable ();
+	    }
+	}
+      else
+	{
+	  res[offset] = *p;
+	  offset += 1;
+	  p += 1;
+	}
+    }
+  res[offset] = '\0';
+
+  return res;
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-structs.cc
@@ -0,0 +1,63 @@
+/* Lowering routines for all things related to structs.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with the yielding of SKIP for the given structured mode.  */
+
+tree
+a68_get_struct_skip_tree (MOID_T *m)
+{
+  /* Build a constructor that assigns SKIPs to each field in the struct
+     type.  */
+
+  vec <constructor_elt, va_gc> *ve = NULL;
+  tree field = TYPE_FIELDS (CTYPE (m));
+  for (PACK_T *elem = PACK (m); elem; FORWARD (elem))
+    {
+      gcc_assert (field != NULL_TREE);
+      CONSTRUCTOR_APPEND_ELT (ve, field, a68_get_skip_tree (MOID (elem)));
+      field = DECL_CHAIN (field);
+    }
+
+  return build_constructor (CTYPE (m), ve);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-unions.cc
@@ -0,0 +1,279 @@
+/* Lowering routines for all things related to unions.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Algol 68 unions are implemented in this front-end as a data structure
+   consisting of an overhead followed by a value:
+
+     overhead%
+     value%
+
+   Where overhead% is an index that identifies the kind of object currently
+   united, and value% is a GENERIC union.  The value currently united in the
+   union is the overhead%-th field in value%.
+
+   At the language level there are no values of union modes in Algol 68.  All
+   values are built from either SKIP (for uninitialized UNION values) or as the
+   result of an uniting coercion.  */
+
+/* Given an union mode P and a mode Q, return whether Q is a mode in P.  */
+
+bool
+a68_union_contains_mode (MOID_T *p, MOID_T *q)
+{
+  while (EQUIVALENT (p) != NO_MOID)
+    p = EQUIVALENT (p);
+
+  for (PACK_T *pack = PACK (p); pack != NO_PACK; FORWARD (pack))
+    {
+      MOID_T *m = MOID (pack);
+
+      if (a68_is_equal_modes (q, m, SAFE_DEFLEXING)
+	  || (m == M_STRING && IS_ROW (q) && SUB (q) == M_CHAR)
+	  || (q == M_STRING && IS_ROW (m) && SUB (m) == M_CHAR))
+	return true;
+    }
+
+  return false;
+}
+
+/* Given an union mode P and a mode Q, return an integer with the index of the
+   occurrence of Q in P.  */
+
+int
+a68_united_mode_index (MOID_T *p, MOID_T *q)
+{
+  int ret = 0;
+  while (EQUIVALENT (p) != NO_MOID)
+    p = EQUIVALENT (p);
+  for (PACK_T *pack = PACK (p); pack != NO_PACK; FORWARD (pack))
+    {
+      MOID_T *m = MOID (pack);
+
+      if (a68_is_equal_modes (q, m, SAFE_DEFLEXING)
+	  || (m == M_STRING && IS_ROW (q) && SUB (q) == M_CHAR)
+	  || (q == M_STRING && IS_ROW (m) && SUB (m) == M_CHAR))
+	return ret;
+      ret += 1;
+    }
+
+  /* Not found.  Shouldn't happen.  */
+  gcc_unreachable ();
+  return 0;
+}
+
+/* Given two united modes FROM and TO, and an overhead FROM_OVERHEAD in mode
+   FROM, return the corresponding overhead in mode TO.
+
+   This function assumes that the mode with FROM_OVERHEAD in mode FROM exists
+   in TO.  */
+
+tree
+a68_union_translate_overhead (MOID_T *from, tree from_overhead,
+			      MOID_T *to)
+{
+  /* Note that the initialization value for to_overhead should never be used.
+     XXX perhaps translate it to a run-time call to abort/compiler-error.  */
+  tree to_overhead = size_int (0);
+
+  from_overhead = save_expr (from_overhead);
+
+  int i = 0;
+  for (PACK_T *pack = PACK (from); pack != NO_PACK; FORWARD (pack), ++i)
+    {
+      MOID_T *mode = MOID (pack);
+
+      if (a68_union_contains_mode (to, mode))
+	{
+	  to_overhead = fold_build3 (COND_EXPR, sizetype,
+				     fold_build2 (EQ_EXPR, boolean_type_node,
+						  from_overhead,
+						  size_int (i)),
+				     size_int (a68_united_mode_index (to, mode)),
+				     to_overhead);
+	}
+    }
+
+  return to_overhead;
+}
+
+/* Get the overhead of a given united value EXP.  */
+
+tree
+a68_union_overhead (tree exp)
+{
+  tree type = TREE_TYPE (exp);
+  tree overhead_field = TYPE_FIELDS (type);
+  return fold_build3 (COMPONENT_REF,
+		      TREE_TYPE (overhead_field),
+		      exp,
+		      overhead_field,
+		      NULL_TREE);
+}
+
+/* Set the overhead of a given united value EXP to OVERHEAD.  */
+
+tree
+a68_union_set_overhead (tree exp, tree overhead)
+{
+  tree type = TREE_TYPE (exp);
+  tree overhead_field = TYPE_FIELDS (type);
+  return fold_build2 (MODIFY_EXPR,
+		      TREE_TYPE (overhead),
+		      fold_build3 (COMPONENT_REF,
+				   TREE_TYPE (overhead_field),
+				   exp,
+				   overhead_field,
+				   NULL_TREE),
+		      overhead);
+}
+
+/* Get the cunion in the given union EXP.  */
+
+tree
+a68_union_cunion (tree exp)
+{
+  tree type = TREE_TYPE (exp);
+  tree value_field = TREE_CHAIN (TYPE_FIELDS (type));
+  return fold_build3 (COMPONENT_REF,
+		      TREE_TYPE (value_field),
+		      exp,
+		      value_field,
+		      NULL_TREE);
+}
+
+/* Build a SKIP value for a given union mode M.
+
+   The SKIP value computed is:
+
+   overhead% refers to the first united mode in the union
+   value% is the SKIP for the first united mode in the union
+*/
+
+tree
+a68_get_union_skip_tree (MOID_T *m)
+{
+  tree type = CTYPE (m);
+  tree overhead_field = TYPE_FIELDS (type);
+  tree value_field = TREE_CHAIN (TYPE_FIELDS (type));
+
+  /* Overhead selects the first union alternative.  */
+  tree overhead = size_zero_node;
+  /* First union alternative.
+
+     Note that the first union alternative corresponds to the last alternative
+     in the mode as written in the source program.  */
+  tree value_type = TREE_TYPE (value_field);
+  tree first_alternative_field = TYPE_FIELDS (value_type);
+  tree value = build_constructor_va (TREE_TYPE (value_field),
+				     1,
+				     first_alternative_field,
+				     a68_get_skip_tree (MOID (PACK (m))));
+  return build_constructor_va (CTYPE (m),
+			       2,
+			       overhead_field, overhead,
+			       value_field, value);
+}
+
+/* Return the alternative (value) at the index INDEX in the united value
+   EXP.  */
+
+tree
+a68_union_alternative (tree exp, int index)
+{
+  tree type = TREE_TYPE (exp);
+  tree value_field = TREE_CHAIN (TYPE_FIELDS (type));
+  tree value = fold_build3 (COMPONENT_REF,
+			    TREE_TYPE (value_field),
+			    exp,
+			    value_field,
+			    NULL_TREE);
+
+  /* Get the current alternative in the value union.  */
+  tree value_type = TREE_TYPE (value_field);
+  tree alternative_field = TYPE_FIELDS (value_type);
+  for (int i = 0; i < index; ++i)
+    {
+      gcc_assert (TREE_CHAIN (alternative_field));
+      alternative_field = TREE_CHAIN (alternative_field);
+    }
+
+  /* Get the current alternative from the value.  */
+  return fold_build3 (COMPONENT_REF,
+		      TREE_TYPE (alternative_field),
+		      value,
+		      alternative_field,
+		      NULL_TREE);
+}
+
+/* Return a constructor for an union of mode MODE, holding the value in EXP
+   which is of mode EXP_MODE.  */
+
+tree
+a68_union_value (MOID_T *mode, tree exp, MOID_T *exp_mode)
+{
+  tree type = CTYPE (mode);
+  tree overhead_field = TYPE_FIELDS (type);
+  tree value_field = TREE_CHAIN (TYPE_FIELDS (type));
+
+  int alternative_index = a68_united_mode_index (mode, exp_mode);
+  tree overhead = build_int_cst (sizetype, alternative_index);
+
+  /* Get the field for the alternative corresponding to alternative_index.  */
+  tree value_type = TREE_TYPE (value_field);
+  tree alternative_field = TYPE_FIELDS (value_type);
+  for (int i = 0; i < alternative_index; ++i)
+    {
+      gcc_assert (TREE_CHAIN (alternative_field));
+      alternative_field = TREE_CHAIN (alternative_field);
+    }
+
+  tree value = build_constructor_va (TREE_TYPE (value_field),
+				     1,
+				     alternative_field,
+				     a68_consolidate_ref (exp_mode, exp));
+  return build_constructor_va (type,
+			       2,
+			       overhead_field, overhead,
+			       value_field, value);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low-units.cc
@@ -0,0 +1,1191 @@
+/* Lower units to GENERIC.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Note that enclosed clauses, which are units, are handled in
+   a68-low-clauses.  */
+
+/* Lower an applied identifier.
+
+   This lowers into the declaration of the referred identifier.  The
+   declaration of the identifier should now be available in the symbol table
+   entry for the identifier.  */
+
+tree
+a68_lower_identifier (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  if (TAG_TABLE (TAX (p)) == A68_STANDENV)
+    {
+      /* This identifier is defined in the standard prelude.  Use its lowering
+	 handler.  */
+      LOWERER_T lowerer = LOWERER (TAX (p));
+      return (*lowerer) (p, ctx);
+    }
+  else
+    {
+      tree id_decl = TAX_TREE_DECL (TAX (p));
+
+      if (id_decl == NULL_TREE)
+	{
+	  /* This is an applied identifier used before the corresponding defining
+	     identifier gets defined in either an identity declaration or a
+	     variable declaration.  Create the declaration and install it in the
+	     symbol table.  The declaration itself, declaration expr and
+	     initialization assignment for the declaration will be emitted by the
+	     corresponding declaration lowering handler.  Note that the defining
+	     identifier (and therefore the declaration associated with this applied
+	     identifier) may be in an outer lexical block.  */
+
+	  if (IS (MOID (p), PROC_SYMBOL))
+	    {
+	      if (VARIABLE (TAX (p)))
+		id_decl = a68_make_variable_declaration_decl (p);
+	      else if (IN_PROC (TAX (p)))
+		id_decl = a68_make_proc_identity_declaration_decl (p);
+	      else
+		id_decl = a68_make_identity_declaration_decl (p);
+	    }
+	  else
+	    {
+	      if (VARIABLE (TAX (p)))
+		id_decl = a68_make_variable_declaration_decl (p);
+	      else
+		id_decl = a68_make_identity_declaration_decl (p);
+	    }
+
+	  TAX_TREE_DECL (TAX (p)) = id_decl;
+	}
+
+      /* If the identifier refers to a FUNCTION_DECL, this means the declaration
+	 was made by a procecure-identity-dclaration.  The applied identifier in
+	 that case refers to the address of the corresponding function.  */
+      if (TREE_CODE (id_decl) == FUNCTION_DECL)
+	return fold_build1 (ADDR_EXPR,
+			    build_pointer_type (TREE_TYPE (id_decl)),
+			    id_decl);
+      else
+	return id_decl;
+    }
+}
+
+/* Lower a string denotation.
+
+   String denotations are of mode []CHAR, and lower into a multiple with a
+   single dimension, and with the following characteristics:
+
+   - The lower bound of dimension 0 is 1.
+   - The upper bound of dimension 0 is strlen (NSYMBOL (p)).
+   - The stride of dimension 0 is 0.
+   - The pointed elements are a buffer of CHARs allocated in the stack.  */
+
+tree
+a68_lower_string_denotation (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  /* First process string breaks.  */
+  char *str = a68_string_process_breaks (NSYMBOL (p));
+
+  /* Build a multiple of UCS-4 CHARs from the resulting UTF-8 string.  */
+  size_t ucslen;
+  uint32_t *ucsbuf = a68_u8_to_u32 ((const uint8_t *) str, strlen (str),
+				    NULL, &ucslen);
+  free (str);
+  tree string_literal = build_string_literal (ucslen * sizeof (uint32_t),
+					      (char *) ucsbuf, a68_char_type);
+  tree elements = string_literal;
+  tree lower_bound = fold_convert (ssizetype, size_one_node);
+  tree upper_bound = ssize_int (ucslen);
+  tree elements_size = fold_build2 (MULT_EXPR, sizetype,
+				    size_int (ucslen),
+				    size_in_bytes (a68_char_type));
+  tree multiple = a68_row_value (CTYPE (M_ROW_CHAR), 1,
+				 elements, elements_size,
+				 &lower_bound, &upper_bound);
+  TREE_CONSTANT (multiple) = true;
+  free (ucsbuf);
+  return multiple;
+}
+
+/* Lower denotation.
+
+     denotation : int denotation; real denotation; bits denotation;
+     		  row char denotation;
+		  true symbol; false symbol;
+		  empty symbol;
+		  longety, int denotation;
+                  longety, real denotation;
+		  longety, bits denotation;
+		  shortety, int denotation;
+		  shortety, real denotation;
+		  shortety, bits denotation.
+
+   Denotations lower into GENERIC cst expressions.  */
+
+tree
+a68_lower_denotation (NODE_T *p, LOW_CTX_T ctx)
+{
+  MOID_T *moid = MOID (p);
+
+  if (moid == M_VOID)
+    /* EMPTY  */
+    return a68_lower_empty (p, ctx);
+  else if (moid == M_BOOL)
+    /* TRUE or FALSE.  */
+    return (NSYMBOL (p)[0] == 'T') ? boolean_true_node : boolean_false_node;
+  else if (moid == M_CHAR)
+    {
+      char *s = a68_string_process_breaks (NSYMBOL (p));
+      uint32_t ucs;
+      int length = a68_u8_mbtouc (&ucs, (const uint8_t *) s, 1);
+      gcc_assert (length == 1);
+      free (s);
+      return build_int_cst (a68_char_type, ucs);
+    }
+  else if (moid == M_ROW_CHAR)
+    return a68_lower_string_denotation (p, ctx);
+  else if (moid == M_INT
+	   || moid == M_LONG_INT
+	   || moid == M_LONG_LONG_INT
+	   || moid == M_SHORT_INT
+	   || moid == M_SHORT_SHORT_INT)
+    {
+      /* SIZETY INT */
+      tree type;
+      char *end;
+      NODE_T *s = NO_NODE;
+      if (IS (SUB (p), LONGETY) || IS (SUB (p), SHORTETY))
+	s = NEXT (SUB (p));
+      else
+	s = SUB (p);
+
+      type = CTYPE (moid);
+      int64_t val = strtol (NSYMBOL (s), &end, 10);
+      gcc_assert (end[0] == '\0');
+      return build_int_cst (type, val);
+    }
+  if (moid == M_BITS
+      || moid == M_LONG_BITS
+      || moid == M_LONG_LONG_BITS
+      || moid == M_SHORT_BITS
+      || moid == M_SHORT_SHORT_BITS)
+    {
+      /* SIZETY BITS */
+
+      tree type;
+      char *end;
+      NODE_T *s = NO_NODE;
+      if (IS (SUB (p), LONGETY) || IS (SUB (p), SHORTETY))
+	s = NEXT (SUB (p));
+      else
+	s = SUB (p);
+
+      type = CTYPE (moid);
+      int64_t radix = strtol (NSYMBOL (s), &end, 10);
+      gcc_assert (end != NSYMBOL (s) && *end == 'r');
+      end++;
+      int64_t val = strtol (end, &end, radix);
+      gcc_assert (end[0] == '\0');
+      return build_int_cst (type, val);
+    }
+  else if (moid == M_REAL
+	   || moid == M_LONG_REAL
+	   || moid == M_LONG_LONG_REAL)
+    {
+      /* SIZETY INT */
+      tree type;
+      NODE_T *s = NO_NODE;
+      if (IS (SUB (p), LONGETY) || IS (SUB (p), SHORTETY))
+	s = NEXT (SUB (p));
+      else
+	s = SUB (p);
+
+      if (moid == M_REAL)
+	type = float_type_node;
+      else if (moid == M_LONG_REAL)
+	type = double_type_node;
+      else if (moid == M_LONG_LONG_REAL)
+	type = long_double_type_node;
+      else
+	gcc_unreachable ();
+
+      REAL_VALUE_TYPE val;
+      real_from_string (&val, NSYMBOL (s));
+      return build_real (type, val);
+    }
+
+  gcc_unreachable ();
+  return NULL_TREE;
+}
+
+/* Lower SKIP.
+
+     skip
+*/
+
+tree
+a68_lower_skip (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_get_skip_tree (MOID (p));
+}
+
+/* Lower NIHIL.
+
+     nihil : nil.
+
+   NIL stands for a name referring to no value and which must be
+   distinguishable from any other name.  It is of mode REF AMODE.  NIL is never
+   subject to coercion and it may only occur where the context is strong,
+   i.e. where AMODE is known at compile-time.
+
+   It lowers to a pointer to AMODE with value 0.  */
+
+tree
+a68_lower_nihil (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  tree type = CTYPE (MOID (p));
+
+  gcc_assert (type == a68_void_type || POINTER_TYPE_P (type));
+  if (type == a68_void_type)
+    return a68_lower_empty (p, ctx);
+  else
+    return build_int_cst (type, 0);
+}
+
+/* Lower EMPTY.  */
+
+tree
+a68_lower_empty (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  return a68_get_empty ();
+}
+
+/* Lower an identity relation.
+
+     identity relation : tertiary, is symbol, tertiary;
+     			 tertiary, isnt symbol, tertiary.
+
+   An identity relation determines whether two name values are the same.  It
+   lowers into EQ_EXPR in case of IS and into NE_EXPR in case of ISNT.  */
+
+tree
+a68_lower_identity_relation (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *lhs = SUB (p);
+  NODE_T *oper = NEXT (lhs);
+  NODE_T *rhs = NEXT (oper);
+
+  /* Consolidate arguments to make sure we are comparing pointers in the
+     r-value context of the EQ_EXPR or NE_EXPR operation below.  */
+  tree op1 = a68_consolidate_ref (MOID (lhs), a68_lower_tree (lhs, ctx));
+  tree op2 = a68_consolidate_ref (MOID (rhs), a68_lower_tree (rhs, ctx));
+
+  tree_code code;
+  if (IS (oper, IS_SYMBOL))
+    code = EQ_EXPR;
+  else if (IS (oper, ISNT_SYMBOL))
+    code = NE_EXPR;
+  else
+    gcc_unreachable ();
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  code, boolean_type_node, op1, op2);
+}
+
+/* Lower AND_FUNCTION and OR_FUNCTION.
+
+     and function : tertiary, andf symbol, tertiary.
+     or function : tertiary, orf_symbol, tertiary.
+
+   These are pseudo-operators that are used to implement short-circuits
+   evaluation of logical expressions.
+
+   These pseudo-operators lower into TRUTH_ANDIF_EXPR or TRUTH_ORIF_EXPR,
+   respectively.  */
+
+tree
+a68_lower_logic_function (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *lhs = SUB (p);
+  NODE_T *oper = NEXT (lhs);
+  NODE_T *rhs = NEXT (oper);
+
+  tree op1 = a68_lower_tree (lhs, ctx);
+  tree op2 = a68_lower_tree (rhs, ctx);
+
+  tree_code code;
+  if (IS (oper, ANDF_SYMBOL))
+    code = TRUTH_ANDIF_EXPR;
+  else if (IS (oper, ORF_SYMBOL))
+    code = TRUTH_ORIF_EXPR;
+  else
+    gcc_unreachable ();
+
+  return fold_build2_loc (a68_get_node_location (p),
+			  code, boolean_type_node, op1, op2);
+}
+
+/* Lower a primary.
+
+     primary : identifier; denotation; cast; enclosed clause; format text.
+
+   The primary lowers into some GENERIC expression.  */
+
+tree
+a68_lower_primary (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_lower_tree (SUB (p), ctx);
+}
+
+/* Lower a cast.
+
+     cast : declarer, enclosed clause;
+            void symbol, enclosed clause.
+
+   A cast establishes a strong context with some required mode.  This context
+   allows coercions to be applied, and these coercions have been inserted in
+   the parse tree by the parser.  */
+
+tree
+a68_lower_cast (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_lower_tree (NEXT (SUB (p)), ctx);
+}
+
+/* Lower a slice.
+
+     slice : MULTIPLE INDEXER
+
+   Slicing a multiple may result in either an element of the multiple, if the
+   operation is indexing, or another multiple, if the operation is a
+   trimming.  */
+
+static void
+lower_subscript_for_indexes (NODE_T *p, LOW_CTX_T ctx)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      switch (ATTRIBUTE (p))
+	{
+	case TRIMMER:
+	  /* Because of ANNOTATION (indexer) == SLICE */
+	  gcc_unreachable ();
+	  break;
+	case UNIT:
+	  a68_add_stmt (a68_lower_tree (p, ctx));
+	  break;
+	case GENERIC_ARGUMENT:
+	case GENERIC_ARGUMENT_LIST:
+	  lower_subscript_for_indexes (SUB (p), ctx);
+	  break;
+	default:
+	  break;
+	}
+    }
+}
+
+static void
+lower_subscript_for_trimmers (NODE_T *p, LOW_CTX_T ctx,
+			      tree multiple, tree new_multiple,
+			      int *dim, int *new_dim,
+			      tree elements_pointer_type)
+{
+  /* new.elements := multiple.elements;
+     FOR dim TO num dimensions
+     DO CO t[dim] is either a subscript i or a trimmer i : j @ k CO
+        new.elements +:= i * multiple.strides[dim];
+        IF t[dim] is a trimmer
+        THEN INT d := ( k is absent | 1 | multiple.lb[dim] - k );
+             new.lb[dim] := multiple.lb[dim] - d;
+	     new.ub[dim] := multiple.ub[dim] - d;
+	     new.strides[dim] := multiple.strides[dim]
+        FI
+     OD
+  */
+
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      switch (ATTRIBUTE (p))
+	{
+	case UNIT:
+	  {
+	    tree unit = save_expr (fold_convert (ssizetype, a68_lower_tree (p, ctx)));
+	    tree new_elements = a68_multiple_elements (new_multiple);
+	    tree size_dim = size_int (*dim);
+	    tree dim_lower_bound = save_expr (a68_multiple_lower_bound (multiple, size_dim));
+	    tree stride = save_expr (a68_multiple_stride (multiple, size_dim));
+
+	    /* Validate bounds.  */
+	    if (OPTION_BOUNDS_CHECKING (&A68_JOB))
+	      a68_add_stmt (a68_multiple_bounds_check (p, size_dim, multiple, unit));
+
+	    /* new_elements += i * strides[dim] */
+	    tree offset = fold_build2 (MULT_EXPR, sizetype,
+				       fold_convert (sizetype, fold_build2 (MINUS_EXPR, ssizetype,
+									    unit, dim_lower_bound)),
+				       stride);
+
+	    offset = save_expr (offset);
+	    new_elements = fold_build2 (POINTER_PLUS_EXPR,
+					elements_pointer_type,
+					new_elements,
+					offset);
+	    a68_add_stmt (a68_multiple_set_elements (new_multiple, new_elements));
+
+	    /* elements_size -= i * strides[dim] */
+	    tree elements_size = a68_multiple_elements_size (new_multiple);
+	    elements_size = fold_build2 (MINUS_EXPR, sizetype,
+					 elements_size, offset);
+	    a68_add_stmt (a68_multiple_set_elements_size (new_multiple, elements_size));
+
+	    *dim += 1;
+	    break;
+	  }
+	case TRIMMER:
+	  {
+	    /* First collect components from the trimmer.  */
+	    tree size_dim = size_int (*dim);
+	    tree dim_lower_bound = save_expr (a68_multiple_lower_bound (multiple, size_dim));
+	    tree lower_bound = dim_lower_bound;
+	    tree upper_bound = save_expr (a68_multiple_upper_bound (multiple, size_dim));
+	    tree at = ssize_int (1);
+
+	    NODE_T *q = SUB (p);
+	    if (q != NO_NODE)
+	      {
+		if (IS (q, AT_SYMBOL))
+		  {
+		    /* Both bounds are implicit.  */
+		    at = save_expr (fold_convert (ssizetype, a68_lower_tree (NEXT (q), ctx)));
+		  }
+		else if (IS (q, COLON_SYMBOL))
+		  {
+		    /* Lower bound is implicit.  */
+		    FORWARD (q);
+		    if (IS (q, AT_SYMBOL))
+		      {
+			/* Upper bound is implicit, AT specified.  */
+			gcc_assert (IS (q, AT_SYMBOL));
+			at = save_expr (fold_convert (ssizetype, a68_lower_tree (NEXT (q), ctx)));
+		      }
+		    else
+		      {
+			upper_bound
+			  = save_expr (fold_convert (ssizetype, a68_lower_tree (q, ctx)));
+			FORWARD (q);
+			if (q != NO_NODE)
+			  {
+			    gcc_assert (IS (q, AT_SYMBOL));
+			    at = save_expr (fold_convert (ssizetype, a68_lower_tree (NEXT (q), ctx)));
+			  }
+		      }
+		  }
+		else
+		  {
+		    /* Lower bound is explicit.  */
+		    lower_bound = fold_convert (ssizetype, a68_lower_tree (q, ctx));
+		    FORWARD (q);
+		    gcc_assert (IS (q, COLON_SYMBOL));
+		    FORWARD (q);
+		    if (q != NO_NODE)
+		      {
+			if (IS (q, AT_SYMBOL))
+			  at = save_expr (fold_convert (ssizetype, a68_lower_tree (NEXT (q), ctx)));
+			else
+			  {
+			    upper_bound
+			      = save_expr (fold_convert (ssizetype, a68_lower_tree (q, ctx)));
+			    FORWARD (q);
+			    if (q != NO_NODE && IS (q, AT_SYMBOL))
+			      at =
+				save_expr (fold_convert (ssizetype, a68_lower_tree (NEXT (q), ctx)));
+			  }
+		      }
+		  }
+	      }
+
+	    /* Time for some bounds checking.
+
+	       Note that in trimmers, given the current dimension's bounds
+	       (L,U), we cannot simply do the check:
+
+	            L <= lower_bound <= U
+		    L <= upper_bound <= U
+
+	       This is because the multiple may be flat, and the dimension may
+	       have bounds such like U < L.  In that case, the expressions
+	       above would always eval to false for any lower_bound and
+	       upper_bound.
+
+	       So we check for this instead:
+
+	            L <= lower_bound AND upper_bound <= U
+
+               This allows to trim a "flat dimension" using a trimmer where
+	       upper_bound < lower_bound.  The result is, of course, another
+	       "flat dimension" in the multiple result of the trimming.  */
+
+	    if (OPTION_BOUNDS_CHECKING (&A68_JOB))
+	      {
+		a68_add_stmt (a68_multiple_single_bound_check (p, size_dim, multiple,
+							       lower_bound,
+							       false /* upper_bound */));
+		a68_add_stmt (a68_multiple_single_bound_check (p, size_dim, multiple,
+							       upper_bound,
+							       true /* upper_bound */));
+	      }
+
+	    /* new_elements += i * strides[dim] */
+	    tree stride = save_expr (a68_multiple_stride (multiple, size_dim));
+	    tree new_elements = a68_multiple_elements (new_multiple);
+	    tree offset = fold_build2 (MULT_EXPR, sizetype,
+				       fold_convert (sizetype, fold_build2 (MINUS_EXPR, ssizetype,
+									    lower_bound, dim_lower_bound)),
+				       stride);
+
+	    offset = save_expr (offset);
+	    new_elements = fold_build2 (POINTER_PLUS_EXPR,
+					elements_pointer_type,
+					new_elements,
+					offset);
+	    a68_add_stmt (a68_multiple_set_elements (new_multiple, new_elements));
+
+	    /* elements_size -= i * strides[dim] */
+	    tree elements_size = a68_multiple_elements_size (new_multiple);
+	    elements_size = fold_build2 (MINUS_EXPR, sizetype,
+					 elements_size, offset);
+	    a68_add_stmt (a68_multiple_set_elements_size (new_multiple,
+							  elements_size));
+
+	    /* Fill the triplet for this dimension in new_multiple.  */
+	    tree size_new_dim = size_int (*new_dim);
+	    tree d = fold_build2 (MINUS_EXPR, ssizetype, lower_bound, at);
+
+	    a68_add_stmt (a68_multiple_set_lower_bound (new_multiple, size_new_dim,
+							fold_build2 (MINUS_EXPR, ssizetype,
+								     lower_bound, d)));
+	    a68_add_stmt (a68_multiple_set_upper_bound (new_multiple, size_new_dim,
+							fold_build2 (MINUS_EXPR, ssizetype,
+								     upper_bound, d)));
+	    a68_add_stmt (a68_multiple_set_stride (new_multiple, size_new_dim, stride));
+
+	    *new_dim += 1;
+	    *dim += 1;
+	    break;
+	  }
+	default:
+	  lower_subscript_for_trimmers (SUB (p), ctx,
+					multiple, new_multiple,
+					dim, new_dim,
+					elements_pointer_type);
+	}
+    }
+}
+
+tree
+a68_lower_slice (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *indexer = NEXT_SUB (p);
+  MOID_T *orig_multiple_mode = MOID (SUB (p));
+  MOID_T *multiple_mode = orig_multiple_mode;
+  bool slicing_name = false;
+
+  /* First of all, lower the multiple being sliced.  If it is a name to a
+     multiple, set a flag and dereference.  */
+  tree multiple = a68_lower_tree (SUB (p), ctx);
+  MOID_T *orig_sliced_multiple_mode = MOID (p);
+  MOID_T *sliced_multiple_mode = MOID (p);
+  size_t slice_num_dimensions = 0;
+  if (IS_REF (MOID (SUB (p))))
+    {
+      slicing_name = true;
+      multiple = a68_low_deref (multiple, SUB (p));
+      multiple_mode = SUB (multiple_mode);
+      slice_num_dimensions = DIM (SUB (MOID (p)));
+      sliced_multiple_mode = SUB (sliced_multiple_mode);
+    }
+  else
+    slice_num_dimensions = DIM (MOID (p));
+
+  tree slice = NULL_TREE;
+  if (ANNOTATION (indexer) == SLICE)
+    {
+      /* The slice has only indexers and no trimmers.  Collect units and slice
+	 an element of the multiple using a68_multiple_slice.  This operation
+	 results in an element of the multiple.  */
+
+      /* Collect units  */
+      a68_push_range (NULL);
+      lower_subscript_for_indexes (SUB (indexer), ctx);
+      tree units = a68_pop_range ();
+
+      /* We need to allocate space for as many indexes as dimensions of the
+	 multiple.  */
+      tree num_dimensions_tree = a68_multiple_dimensions (multiple);
+      gcc_assert (TREE_CODE (num_dimensions_tree) == INTEGER_CST);
+      int num_dimensions = tree_to_shwi (num_dimensions_tree);
+
+      int num_indexes = 0;
+      tree *indexes = (tree *) xmalloc (sizeof (tree) * num_dimensions);
+      for (tree_stmt_iterator si = tsi_start (units);
+	   !tsi_end_p (si);
+	   tsi_next (&si))
+	{
+	  /* Add the unit to the list of indexes.  */
+	  indexes[num_indexes] = tsi_stmt (si);
+	  num_indexes++;
+	}
+      gcc_assert (num_indexes == num_dimensions);
+
+      /* Slice.  */
+      slice = a68_multiple_slice (p, multiple, slicing_name,
+				  num_indexes, indexes);
+      free (indexes);
+    }
+  else if (ANNOTATION (indexer) == TRIMMER)
+    {
+      /* The slice has both indexers and trimmers.  Traverse the indexer
+	 subtree to obtain the descriptor of the trimmed multiple (which is
+	 another multiple) and the pointer to the elements, which points to
+	 some position within the elements of the trimmed multiple.  This
+	 operation results in a new multiple of the same mode than the trimmed
+	 multiple with shared elements.  */
+
+      a68_push_range (sliced_multiple_mode);
+
+      tree sliced_multiple = a68_lower_tmpvar ("multiple%", TREE_TYPE (multiple),
+					       multiple);
+      tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * slice_num_dimensions);
+      tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * slice_num_dimensions);
+      tree ssize_one_node = fold_convert (ssizetype, size_one_node);
+      tree ssize_zero_node = fold_convert (ssizetype, size_zero_node);
+      for (size_t d = 0; d < slice_num_dimensions; ++d)
+	{
+	  /* Note that these dummy bounds and the implied strides will be
+	     overwritten by lower_subscript_for_trimmers below.  */
+	  lower_bounds[d] = ssize_one_node;
+	  upper_bounds[d] = ssize_zero_node;
+	}
+      tree new_multiple = a68_row_value (CTYPE (sliced_multiple_mode),
+					 slice_num_dimensions,
+					 a68_multiple_elements (sliced_multiple),
+					 a68_multiple_elements_size (sliced_multiple),
+					 lower_bounds, upper_bounds);
+      new_multiple = save_expr (new_multiple);
+      new_multiple = a68_lower_tmpvar ("new_multiple%", TREE_TYPE (new_multiple),
+				       new_multiple);
+
+      int dim = 0;
+      int new_dim = 0;
+      lower_subscript_for_trimmers (SUB (indexer), ctx,
+				    sliced_multiple, new_multiple,
+				    &dim, &new_dim,
+				    a68_row_elements_pointer_type (TREE_TYPE (multiple)));
+      a68_add_stmt (new_multiple);
+      slice = a68_pop_range ();
+
+      /* In case we are slicing a ref to a multiple, return the address of the
+	 resulting multiple and not the multiple itself.  But in this case we
+	 need an address in the heap, because the trimmed multiple may be in
+	 the heap and the result shall have the same scope.  */
+      if (slicing_name)
+	{
+	  tree ptrtype = CTYPE (orig_sliced_multiple_mode);
+	  tree slice_addr = fold_build1 (ADDR_EXPR, ptrtype, slice);
+	  tree alloc = a68_lower_malloc (ptrtype, size_in_bytes (TREE_TYPE (slice)));
+	  alloc = save_expr (alloc);
+	  tree copy = a68_lower_memcpy (alloc, slice_addr, size_in_bytes (TREE_TYPE (slice)));
+
+	  slice = fold_build2 (COMPOUND_EXPR, ptrtype, copy, alloc);
+	}
+    }
+  else
+    gcc_unreachable ();
+
+  return slice;
+}
+
+/* Lower a selection.
+
+     selection : selector, secondary.
+     selector : field identifier, of symbol.
+
+   The selection lowers into a COMPONENT_REF of the field corresponding to the
+   field identifier.  */
+
+tree
+a68_lower_selection (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *secondary = NEXT (SUB (p));
+  NODE_T *field_identifier = SUB (SUB (p));
+
+  MOID_T *secondary_mode = MOID (secondary);
+  tree secondary_expr = a68_lower_tree (secondary, ctx);
+
+  tree res = NULL_TREE;
+
+  /* If the secondary is an address, we need to indirect.  */
+  if (IS_REF (secondary_mode))
+    {
+      secondary_expr = a68_low_deref (secondary_expr, secondary);
+      secondary_mode = SUB (secondary_mode);
+    }
+
+  if (IS_FLEX (secondary_mode) || IS_ROW (secondary_mode))
+    {
+      /* This is the selection of a multiple of structs.
+
+	 The result is a multiple with same dimensions, dimension bounds and
+	 strides than the indexed multiple.  The elements pointer is made to
+	 point to the selected field of the first struct.  */
+
+      MOID_T *result_mode = MOID (p);
+      if (IS_REF (result_mode))
+	result_mode = SUB (result_mode);
+      MOID_T *struct_mode = SUB (secondary_mode);
+      tree field_id = a68_get_mangled_identifier (SYMBOL (INFO (field_identifier)));
+      tree struct_type = CTYPE (struct_mode);
+      a68_push_range (result_mode);
+      tree selection = a68_lower_tmpvar ("selection%", CTYPE (result_mode),
+					 a68_get_skip_tree (result_mode));
+      tree multiple = a68_lower_tmpvar ("multiple%", TREE_TYPE (secondary_expr),
+					secondary_expr);
+
+      /* First set the bounds of the selection, which are exactly the same
+	 bounds than the selected multiple.  */
+      for (int dim = 0; dim < DIM (DEFLEX (secondary_mode)); ++dim)
+	{
+	  tree size_dim = size_int (dim);
+	  tree lower_bound = a68_multiple_lower_bound (multiple, size_dim);
+	  tree upper_bound = a68_multiple_upper_bound (multiple, size_dim);
+	  tree stride = a68_multiple_stride (multiple, size_dim);
+	  a68_add_stmt (a68_multiple_set_lower_bound (selection, size_dim,
+						      lower_bound));
+	  a68_add_stmt (a68_multiple_set_upper_bound (selection, size_dim,
+						      upper_bound));
+	  a68_add_stmt (a68_multiple_set_stride (selection, size_dim,
+						 stride));
+	}
+
+      /* Now set the elements pointer, which is the elements pointer of the
+	 selected multiple offset the offset of the selected field in its
+	 struct type.  */
+      tree elements = a68_multiple_elements (selection);
+      tree multiple_elements = a68_multiple_elements (multiple);
+      tree multiple_elements_size = a68_multiple_elements_size (multiple);
+      tree element_pointer_type = TREE_TYPE (elements);
+      tree field_offset = NULL_TREE;
+      for (tree f = TYPE_FIELDS (struct_type); f; f = DECL_CHAIN (f))
+	{
+	  if (field_id == DECL_NAME (f))
+	    {
+	      field_offset = byte_position (f);
+	      break;
+	    }
+	}
+      gcc_assert (field_offset != NULL_TREE);
+      a68_add_stmt (a68_multiple_set_elements (selection,
+					       fold_build2 (POINTER_PLUS_EXPR,
+							    element_pointer_type,
+							    multiple_elements,
+							    field_offset)));
+
+      /* The size of the buffer pointed by the elements pointer has to be
+	 adjusted accordingly.  */
+      a68_add_stmt (a68_multiple_set_elements_size (selection,
+						    fold_build2 (MINUS_EXPR, sizetype,
+								 multiple_elements_size,
+								 field_offset)));
+
+      a68_add_stmt (selection);
+      res = a68_pop_range ();
+    }
+  else
+    {
+      /* This is the selection of a struct field.  */
+      gcc_assert (A68_STRUCT_TYPE_P (TREE_TYPE (secondary_expr)));
+
+      /* Search for the selected field in the struct type.  */
+      tree struct_type = TREE_TYPE (secondary_expr);
+      tree field_id = a68_get_mangled_identifier (SYMBOL (INFO (field_identifier)));
+      tree field = NULL_TREE;
+      for (tree f = TYPE_FIELDS (struct_type); f; f = DECL_CHAIN (f))
+	{
+	  if (field_id == DECL_NAME (f))
+	    {
+	      field = f;
+	      break;
+	    }
+	}
+      gcc_assert (field != NULL_TREE);
+
+      /* Emit the COMPONENT_REF.  */
+      res = fold_build3_loc (a68_get_node_location (p),
+			     COMPONENT_REF,
+			     TREE_TYPE (field),
+			     secondary_expr,
+			     field,
+			     NULL_TREE);
+    }
+
+  /* The selection of a name yields a name.  */
+  if (IS_REF (MOID (secondary)))
+    /* XXX This may require copying.  */
+    return fold_build1 (ADDR_EXPR, CTYPE (MOID (p)), res);
+  else
+    return res;
+}
+
+/* Lower a secondary.
+
+     secondary : primary; generator; selection.
+
+   The secondary lowers into some GENERIC expression.  */
+
+tree
+a68_lower_secondary (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_lower_tree (SUB (p), ctx);
+}
+
+/* Lower a formula.
+
+     formula : secondary, operator, secondary;
+     	       secondary, operator, monadic formula;
+	       secondary, operator, formula;
+	       monadic formula;
+	       monadic formula, operator, secondary;
+	       monadic formula, operator, monadic formula;
+	       monadic formula, operator, formula;
+	       formula, operator, secondary;
+	       formula, operator, monadic formula;
+	       formula, operator, formula.
+
+   The formula lowers into some GENERIC expression.  */
+
+tree
+a68_lower_formula (NODE_T *p, LOW_CTX_T ctx)
+{
+  if (IS (SUB (p), MONADIC_FORMULA) && NEXT (SUB (p)) == NO_NODE)
+    return a68_lower_tree (SUB (p), ctx);
+  else
+    {
+      /* If the operator is defined in the standard prelude, then use its lowering
+	 code.  */
+      if (TAG_TABLE (TAX (NEXT (SUB (p)))) == A68_STANDENV)
+	{
+	  LOWERER_T lowerer = LOWERER (TAX (NEXT (SUB (p))));
+	  return (*lowerer) (p, ctx);
+	}
+      else
+	{
+	  tree arg1 = a68_lower_tree (SUB (p), ctx);
+	  tree op = a68_lower_tree (NEXT (SUB (p)), ctx);
+	  tree arg2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx);
+
+	  if (POINTER_TYPE_P (TREE_TYPE (op)))
+	    op = fold_build1 (INDIRECT_REF,
+			      TREE_TYPE (TREE_TYPE (op)),
+			      op);
+	  return build_call_expr_loc (a68_get_node_location (p), op, 2, arg1, arg2);
+	}
+    }
+}
+
+/* Lower a monadic formula.
+
+     monadic formula : operator, secondary;
+                       operator, monadic formula.
+
+   The monadic formula lowers into some GENERIC expression.  */
+
+tree
+a68_lower_monadic_formula (NODE_T *p, LOW_CTX_T ctx)
+{
+  /* If the operator is defined in the standard prelude, then use its lowering
+     code.  */
+  if (TAG_TABLE (TAX (SUB (p))) == A68_STANDENV)
+    {
+      LOWERER_T lowerer = LOWERER (TAX (SUB (p)));
+      return (*lowerer) (p, ctx);
+    }
+  else
+    {
+      tree op = a68_lower_tree (SUB (p), ctx);
+      tree secondary = a68_lower_tree (NEXT (SUB (p)), ctx);
+
+      if (POINTER_TYPE_P (TREE_TYPE (op)))
+	op = fold_build1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (op)), op);
+      return build_call_expr_loc (a68_get_node_location (p), op, 1, secondary);
+    }
+}
+
+/* Lower a tertiary.
+
+     tertiary : nihil; monadic formula; formula; secondary.
+
+  The tertiary lowers to some GENERIC expression.  */
+
+tree
+a68_lower_tertiary (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_lower_tree (SUB (p), ctx);
+}
+
+/* Lower an assignation.
+
+     assignation : tertiary, assign symbol, tertiary;
+                   tertiary, assign symbol, identity relation;
+		   tertiary, assign symbol, and function;
+		   tertiary, assign symbol, or function;
+		   tertiary, assign symbol, routine text;
+		   tertiary, assign symbol, jump;
+		   tertiary, assign symbol, skip;
+		   tertiary, assign symbol, assignation;
+		   tertiary, assign symbol, code clause.
+
+   An assignation lowers into appending a MODIFY_EXPR to the statements list,
+   and the result of the expression is the left hand side.  A compound
+   expression fits perfectly */
+
+tree
+a68_lower_assignation (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *lhs_node = SUB (p);
+  NODE_T *rhs_node = NEXT (NEXT (SUB (p)));
+  tree lhs = a68_lower_tree (lhs_node, ctx);
+  tree rhs = a68_lower_tree (rhs_node, ctx);
+
+  return a68_low_assignation (p,
+			      lhs, MOID (lhs_node),
+			      rhs, MOID (rhs_node));
+}
+
+/* Lower a generator.
+
+     generator : loc symbol, declarer;
+                 heap symbol, declarer;
+		 new symbol, declarer.
+
+   LOC generators lower into calls to BUILT_IN_ALLOCA.
+   HEAP generators lower into calls to malloc.  */
+
+tree
+a68_lower_generator (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *declarer = NEXT (SUB (p));
+  return a68_low_generator (declarer,
+			    MOID (declarer),
+			    !IS (SUB (p), LOC_SYMBOL),
+			    ctx);
+}
+
+/* Lower a procedure call.
+
+ */
+
+static void
+collect_call_arguments (NODE_T *p, vec<tree, va_gc> *args, LOW_CTX_T ctx)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, UNIT))
+	{
+	  /* In Algol 68 parameters are passed via an identity declaration, so
+	     this must implement same semantics.  */
+	  tree arg = a68_lower_tree (p, ctx);
+	  if (HAS_ROWS (MOID (p)))
+	    arg = a68_low_dup (arg);
+	  arg = a68_consolidate_ref (MOID (p), arg);
+	  args->quick_push (arg);
+	}
+      else
+	collect_call_arguments (SUB (p), args, ctx);
+    }
+}
+
+tree
+a68_lower_call (NODE_T *p, LOW_CTX_T ctx)
+{
+  MOID_T *proc_mode = MOID (SUB (p));
+  MOID_T *ret_mode = SUB (proc_mode);
+  unsigned int nargs = DIM (proc_mode);
+
+  /* Collect arguments.  */
+  vec<tree, va_gc> *args;
+  vec_alloc (args, nargs);
+  collect_call_arguments (NEXT (SUB (p)), args, ctx);
+
+  /* Lower the primary to call.  */
+  tree primary = a68_lower_tree (SUB (p), ctx);
+
+  /* We need a pointer to a function type.  */
+  if (!POINTER_TYPE_P (TREE_TYPE (primary)))
+    primary = fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (primary)),
+			   primary);
+
+  /* Build a function call.  */
+  tree call = build_call_vec (CTYPE (ret_mode), primary, args);
+  SET_EXPR_LOCATION (call, a68_get_node_location (p));
+  return call;
+}
+
+/* Lower a routine text.
+
+     routine text : parameter pack, (declarer ; void symbol), colon symbol, assignation;
+                    parameter pack, (declarer ; void symbol), colon symbol, identity relation;
+		    parameter pack, (declarer ; void symbol), colon symbol, and function;
+		    parameter pack, (declarer ; void symbol), colon symbol, or runction;
+		    parameter pack, (declarer ; void symbol), colon symbol, jump;
+		    parameter pack, (declarer ; void symbol), colon symbol, skip;
+		    parameter pack, (declarer ; void symbol), colon symbol, tertiary;
+		    parameter pack, (declarer ; void symbol), colon symbol, routine text;
+		    parameter pack, (declarer ; void symboL), colon symbol, code clause;
+                    (declarer ; void symbol), colon symbol, assignation;
+                    (declarer ; void symbol), colon symbol, identity relation;
+		    (declarer ; void symbol), colon symbol, and function;
+		    (declarer ; void symbol), colon symbol, or runction;
+		    (declarer ; void symbol), colon symbol, jump;
+		    (declarer ; void symbol), colon symbol, skip;
+		    (declarer ; void symbol), colon symbol, tertiary;
+		    (declarer ; void symbol), colon symbol, routine text;
+		    (declarer ; void symbol), colon symbol, code clause.
+
+  Routine texts are used to create routines.  They can stand as the actual
+  parameter of an identity declaration, as the actual parameter of a call, or
+  as the right-hand side of an assignation.
+
+  This lowering function is called in two different contexts:
+
+  1) As part of a routine-identity-declaration, in which case the routine
+     resulting from this routine-text is beign ascribed to an identifier given
+     in ctx.proc_decl_identifier.  In that case, we lower to a FUNC_DECL
+     initialized with the body of the routine-text.
+
+  2) As a free standing routine-text.  In that case ctx.proc_decl_identifier is
+     NO_NODE. We lower to the address of a FUNC_DECL that features some unique
+     name.  This pointer will then likely be assigned or ascribed to some
+     variable or identifier in non-contracted identity declaration, but we
+     cannot assume that so we have to opt for the indirection.  */
+
+tree
+a68_lower_routine_text (NODE_T *p, LOW_CTX_T ctx)
+{
+  NODE_T *s = SUB (p);
+
+  tree func_decl = NULL_TREE;
+  NODE_T *defining_identifier = ctx.proc_decl_identifier;
+  if (defining_identifier != NO_NODE)
+    {
+      /* The routine-text is part of a routine-identity-declaration.  */
+      func_decl = TAX_TREE_DECL (TAX (defining_identifier));
+      if (func_decl == NULL_TREE)
+	{
+	  func_decl = a68_make_proc_identity_declaration_decl (defining_identifier);
+	  TAX_TREE_DECL (TAX (defining_identifier)) = func_decl;
+	}
+    }
+  else
+    /* The routine-text is free standing.  */
+    func_decl = a68_make_anonymous_routine_decl (MOID (p));
+
+  a68_add_decl (func_decl);
+  a68_add_decl_expr (fold_build1_loc (a68_get_node_location (p),
+				      DECL_EXPR,
+				      TREE_TYPE (func_decl),
+				      func_decl));
+  announce_function (func_decl);
+
+  /* PARAMETER_PACK.  */
+  NODE_T *parameter_pack_node = NO_NODE;
+  tree parameter_pack = NULL_TREE; /* This is computed below.  */
+  if (IS (s, PARAMETER_PACK))
+    {
+      parameter_pack_node = s;
+      FORWARD (s);
+    }
+
+  /* DECLARER or VOID_SYMBOL */
+  if (IS (s, DECLARER) || IS (s, VOID_SYMBOL))
+    /* This is not used, as this formal declarer is also available in the
+       procedure mode.  So just skip it.  */
+    FORWARD (s);
+
+  /* Skip the COLON_SYMBOL.  */
+  gcc_assert (IS (s, COLON_SYMBOL));
+  FORWARD (s);
+
+  /* Lower the function body.
+
+     This should be done in a new range in which the formal parameters of the
+     routine-text have been declared.  */
+  a68_push_function_range (func_decl, CTYPE (SUB (MOID (p))) /* result_type */);
+  if (parameter_pack_node != NO_NODE)
+    parameter_pack = a68_lower_tree (parameter_pack_node, ctx);
+  DECL_ARGUMENTS (func_decl) = parameter_pack;
+  ctx.proc_decl_identifier = NO_NODE;
+  tree func_body = a68_lower_tree (s, ctx);
+  a68_pop_function_range (func_body);
+
+  if (defining_identifier != NO_NODE)
+    /* Routine-text immediately ascribed to some identifier in a
+       proc-identity-declaration.  Return the FUNC_DECL.  */
+    return func_decl;
+  else
+    /* Free standing routine-text.  Return its address.  */
+    return fold_build1 (ADDR_EXPR,
+			build_pointer_type (TREE_TYPE (func_decl)),
+			func_decl);
+}
+
+/* Lower an unit.
+
+      unit : assignation; identity relation;
+             and function; or function; routine text;
+             jump; skip; tertiary; assertion; code clause.
+
+   The unit lowers to an expression.  */
+
+tree
+a68_lower_unit (NODE_T *p, LOW_CTX_T ctx)
+{
+  return a68_lower_tree (SUB (p), ctx);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-low.cc
@@ -0,0 +1,1152 @@
+/* Lower the Algol 68 parse tree to GENERIC.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "diagnostic.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* Return a tree with an identifier for the mangled version of a given
+   name.  */
+
+tree
+a68_get_mangled_identifier (const char *name)
+{
+  char *mangled_name = (char *) alloca (strlen (name) + 1);
+  memcpy (mangled_name, name, strlen (name) + 1);
+
+  /* Avoid MONADS and NOMADS.  */
+  for (char *p = mangled_name; *p != '\0'; ++p)
+    {
+      if (strchr (MONADS, *p) != NULL || strchr (NOMADS, *p) != NULL
+	  || strchr (":=", *p))
+	*p = '_';
+    }
+
+  return get_identifier (mangled_name);
+}
+
+/* Return a tree with the EMPTY value.
+
+   EMPTY is the only denotation of the VOID mode.  It is used in unions to
+   denote "no value".  It must have size zero, so it lowers into an empty
+   constructor with zero elements of type void.  This is what GNU C uses to
+   implement the empty struct extension.  */
+
+tree
+a68_get_empty (void)
+{
+  return build_constructor (a68_void_type, NULL);
+}
+
+/* Return a tree with the yielding of SKIP of a given mode.
+
+   SKIP stands for some value of some given mode.  It shall be used only in a
+   context where the compiler can determine the mode.
+
+   The particular value to which it elaborates is non-important, but this
+   compiler always uses the same values.  See the a68_get_ref_*_tree functions
+   for details on what values are these.  */
+
+tree
+a68_get_skip_tree (MOID_T *m)
+{
+  tree expr = NULL_TREE;
+
+  while (EQUIVALENT (m) != NO_MOID)
+    m = EQUIVALENT (m);
+
+  if (IS_INTEGRAL (m))
+    expr = a68_get_int_skip_tree (m);
+  else if (m == M_CHAR)
+    expr = a68_get_char_skip_tree ();
+  else if (m == M_BOOL)
+    expr = a68_get_bool_skip_tree ();
+  else if (IS_REAL (m))
+    expr = a68_get_real_skip_tree (m);
+  else if (IS_BITS (m))
+    expr = a68_get_bits_skip_tree (m);
+  else if (IS_REF (m))
+    expr = a68_get_ref_skip_tree (m);
+  else if (IS (m, PROC_SYMBOL))
+    expr = a68_get_proc_skip_tree (m);
+  else if (IS_STRUCT (m))
+    expr = a68_get_struct_skip_tree (m);
+  else if (IS_UNION (m))
+    expr = a68_get_union_skip_tree (m);
+  else if (IS_FLEXETY_ROW (m))
+    expr = a68_get_multiple_skip_tree (m);
+  else if (m == M_STRING)
+      expr = a68_get_string_skip_tree ();
+  else if (m == M_ROWS  || IS (m, SERIES_MODE))
+    {
+      /* XXX assert that all modes in the series are rows? */
+      tree rows_type = CTYPE (M_ROWS);
+      tree dim_field = TYPE_FIELDS (rows_type);
+      tree triplets_field = TREE_CHAIN (dim_field);
+      tree null_pointer = build_int_cst (TREE_TYPE (triplets_field), 0);
+      expr = build_constructor_va (rows_type, 2,
+				   dim_field, size_zero_node,
+				   triplets_field, null_pointer);
+    }
+  else if (m == M_VOID || m == M_HIP)
+    expr = a68_get_empty ();
+  else
+    {
+      fatal_error (UNKNOWN_LOCATION,
+		   "get skip tree: cannot compute SKIP for mode %s",
+		   a68_moid_to_string (m, MOID_ERROR_WIDTH, NODE (m), true));
+      gcc_unreachable ();
+    }
+
+  return expr;
+}
+
+/* Given a tree node EXP holding a value of mode M:
+
+   *NUM_REFS is set to the number of REFs in M.
+
+   *NUM_POINTERS is set to the number of pointers in the type of EXP that
+   correspond to the REFs in M.  */
+
+void
+a68_ref_counts (tree exp, MOID_T *m, int *num_refs, int *num_pointers)
+{
+  /* Count REFs in M and pointers in the type of EXP.  Note that VAR_DECLs
+     corresponding to REF PROC are of type pointer, so these should not count
+     for the count!  */
+
+  /* Make sure we are accessing the real mode definition.  */
+  while (EQUIVALENT (m) != NO_MOID)
+    m = EQUIVALENT (m);
+
+  *num_refs = 0;
+  *num_pointers = 0;
+  for (MOID_T *s = m; s != NO_MOID && IS_REF (s); s = SUB (s))
+    *num_refs += 1;
+  for (tree p = TREE_TYPE (exp);
+       p != NULL_TREE && POINTER_TYPE_P (p) && TREE_CODE (TREE_TYPE (p)) != FUNCTION_TYPE;
+       p = TREE_TYPE (p))
+    *num_pointers += 1;
+
+  gcc_assert (*num_refs >= *num_pointers);
+}
+
+/* The Algol 68 variable declaration
+
+     [LOC|HEAP] AMODE foo;
+
+   Is in principle equivalent to the identity declaration
+
+     REF AMODE foo = [LOC|HEAP] AMODE;
+
+   In both cases the object ascribed to the defining identifier `foo' is of
+   mode REF AMODE.  The ascribed object is a name which is created by a
+   generator implied in the actual declarer in the first case, and an explicit
+   generator in the initialization expression in the second case.
+
+   However, this front-end implements these two cases differently in order to
+   reduce the amount of both indirect addressing and of storage:
+
+   - The variable declaration `[LOC|HEAP] AMODE foo;' lowers into a VAR_DECL
+     with type ATYPE provided that the generator is LOC and that it contains no
+     rows.  Accessing it requires direct addressing.  When its address is
+     required, an ADDR_EXPR shall be used.
+
+   - The identity declaration `REF AMODE foo = LOC AMODE;' lowers into a
+     VAR_DECL with type *ATYPE.  Accessing it requires indirect addressing.  It
+     is effectively a pointer.
+
+   This introduces the complication that an expression (the VAR_DECL) whose
+   type is TYPE can appear in a place where *TYPE is expected.  This function,
+   given the required mode and an expression, adds as many ADDR_EXPR to EXPR as
+   necessary so the resulting value is of the required type.  Other than this
+   nuisance, the parser guarantees that the entities have the right type at the
+   location they appear, so a call to a68_consolidate_ref is all must be needed
+   at any point in the lowering process to guarantee a valid value for the
+   context.
+
+   This function expects:
+   - That the type of EXPR is zero or more pointers to a base type BTYPE.
+   - That the mode M is zero or more REFs to a base non-ref mode AMODE.
+   - That the number of pointers in the type of EXPR is less or equal than the
+     number of REFs in the mode M.
+   - That BTYPE and AMODE are equivalent.  */
+
+tree
+a68_consolidate_ref (MOID_T *m, tree expr)
+{
+  int num_refs, num_pointers;
+  a68_ref_counts (expr, m, &num_refs, &num_pointers);
+
+  /* Address EXPR as many times as necessary to match the number of REFs in the
+     desired mode.  */
+  while (num_pointers < num_refs)
+    {
+      if (TREE_CODE (expr) == COMPOUND_EXPR)
+	{
+	  /* (..., x) -> (..., &x) */
+	  //	  gcc_assert (TREE_CODE (TREE_OPERAND (expr, 0)) == MODIFY_EXPR);
+	  //	  gcc_assert (VAR_P (TREE_OPERAND (expr, 1)));
+	  TREE_OPERAND (expr, 1) = a68_consolidate_ref (m, TREE_OPERAND (expr, 1));
+	  TREE_TYPE (expr) = TREE_TYPE (TREE_OPERAND (expr, 1));
+	}
+      else
+	{
+	  /* x -> &x */
+	  if (TREE_CODE (expr) == INDIRECT_REF)
+	    /* expr is an indirection.  Remove the pointer rather than adding
+	       an addr.  This avoids &* situations and marking stuff as
+	       addressable unnecessarily.  */
+	    expr = TREE_OPERAND (expr,0);
+	  else
+	    {
+	      TREE_ADDRESSABLE (expr) = true;
+	      expr = fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (expr)), expr);
+	    }
+	}
+      num_pointers += 1;
+    }
+
+  return expr;
+}
+
+/* Make a declaration for an anonymous routine of mode MODE.  */
+
+tree
+a68_make_anonymous_routine_decl (MOID_T *mode)
+{
+  /* The CTYPE of MODE is a pointer to a function.  We need the pointed
+     function type for the FUNCTION_DECL.  */
+  tree func_type = TREE_TYPE (CTYPE (mode));
+  tree func_decl = build_decl (UNKNOWN_LOCATION,
+			       FUNCTION_DECL,
+			       NULL_TREE /* name, set below.  */,
+			       func_type);
+  char *name = xasprintf ("routine%d", DECL_UID (func_decl));
+  DECL_NAME (func_decl) = a68_get_mangled_identifier (name);
+  free (name);
+  DECL_EXTERNAL (func_decl) = 0;
+  DECL_STATIC_CHAIN (func_decl) = !a68_in_global_range ();
+  /* Nested functions should be addressable.
+     XXX this should be propagated to their containing functions, so for now
+     we mark them all as addressable.  */
+  TREE_ADDRESSABLE (func_decl) = 1;
+  /* A nested function is not global.  */
+  TREE_PUBLIC (func_decl) = a68_in_global_range ();
+  TREE_STATIC (func_decl) = 1;
+
+  return func_decl;
+}
+
+/* Make a declaration for a constant procedure or operator.  */
+
+tree
+a68_make_proc_identity_declaration_decl (NODE_T *identifier)
+{
+  /* The CTYPE of MODE is a pointer to a function.  We need the pointed
+     function type for the FUNCTION_DECL.  */
+  tree func_type = TREE_TYPE (CTYPE (MOID (identifier)));
+  tree func_decl = build_decl (UNKNOWN_LOCATION,
+			       FUNCTION_DECL,
+			       a68_get_mangled_identifier (NSYMBOL (identifier)),
+			       func_type);
+  DECL_EXTERNAL (func_decl) = 0;
+  DECL_STATIC_CHAIN (func_decl) = !a68_in_global_range ();
+  /* Nested functions should be addressable.
+     XXX this should be propagated to their containing functions, so for now
+     we mark them all as addressable.  */
+  TREE_ADDRESSABLE (func_decl) = 1;
+  /* A nested function is not global.  */
+  TREE_PUBLIC (func_decl) = a68_in_global_range ();
+  TREE_STATIC (func_decl) = 1;
+
+  return func_decl;
+}
+
+/* Make a declaration for an identity declaration.  */
+
+tree
+a68_make_identity_declaration_decl (NODE_T *identifier)
+{
+  tree type = CTYPE (MOID (identifier));
+
+  tree decl = build_decl (a68_get_node_location (identifier),
+			  VAR_DECL,
+			  a68_get_mangled_identifier (NSYMBOL (identifier)),
+			  type);
+  TREE_PUBLIC (decl) = 0;
+#if 0
+  if (!IS_REF (MOID (identifier)))
+    TREE_CONSTANT (decl) = 1;
+#endif
+  DECL_INITIAL (decl) = a68_get_skip_tree (MOID (identifier));
+  return decl;
+}
+
+/* Make a declaration for a variable declaration.
+   The mode of the given identifier is expected to be a REF AMODE.  */
+
+tree
+a68_make_variable_declaration_decl (NODE_T *identifier)
+{
+  gcc_assert (IS_REF (MOID (identifier)));
+
+  MOID_T *mode = MOID (identifier);
+  bool use_pointer = ((HEAP (TAX (identifier)) == HEAP_SYMBOL)
+		      || HAS_ROWS (SUB (MOID (identifier))));
+  tree type = use_pointer ? CTYPE (mode) : CTYPE (SUB (mode));
+  tree decl = build_decl (a68_get_node_location (identifier),
+			  VAR_DECL,
+			  a68_get_mangled_identifier (NSYMBOL (identifier)),
+			  type);
+  TREE_PUBLIC (decl) = 0;
+  DECL_INITIAL (decl) = a68_get_skip_tree (use_pointer ? mode : SUB (mode));
+  return decl;
+}
+
+/* Do a checked indirection.
+
+   P is a tree node used for its location information.
+   EXP is an expression that gets indirected.
+   EXP_MODE is the mode of exp.  */
+
+tree
+a68_checked_indirect_ref (NODE_T *p, tree exp, MOID_T *exp_mode)
+{
+  tree exp_type = TREE_TYPE (exp);
+  tree nil_check = NULL_TREE;
+
+  if (OPTION_NIL_CHECKING (&A68_JOB))
+    {
+      exp = save_expr (exp);
+      tree consolidated_exp = a68_consolidate_ref (exp_mode, exp);
+
+      /* Check whether we are dereferencing NIL.  */
+      unsigned int lineno = NUMBER (LINE (INFO (p)));
+      const char *filename_str = FILENAME (LINE (INFO (p)));
+      tree filename = build_string_literal (strlen (filename_str) + 1,
+					    filename_str);
+      tree call = a68_build_libcall (A68_LIBCALL_DEREFNIL,
+					 void_type_node, 2,
+					 filename,
+					 build_int_cst (unsigned_type_node, lineno));
+      call = fold_build2 (COMPOUND_EXPR, a68_bool_type, call, boolean_false_node);
+      nil_check = fold_build2 (NE_EXPR, exp_type,
+			       consolidated_exp,
+			       build_int_cst (exp_type, 0));
+      nil_check = fold_build2 (TRUTH_ORIF_EXPR, exp_type,
+			       nil_check, call);
+    }
+
+  tree deref = fold_build1 (INDIRECT_REF, TREE_TYPE (exp_type), exp);
+  if (nil_check == NULL_TREE)
+    return deref;
+  else
+    return fold_build2 (COMPOUND_EXPR, TREE_TYPE (deref),
+			nil_check, deref);
+}
+
+/* Deref a given expression EXP whose mode is MOID (P).
+
+   The dereferenced value always corresponds to a name, but it may consist of:
+
+   - Not a pointer, in which case corresponds to a name lowered to a VAR_DECL.
+
+   - A pointer to a function, in which case corresponds to a name of mode REF
+     PROC, lowered to a VAR_DECL.
+
+   - Any other pointer corresponds to a name lowered to a VAR_DECL that is a
+     pointer.
+
+     In the first two cases, in both r-value and l-value situations the
+     expected result is achieved by just returning the value: in r-value the
+     decl denotes the value, in l-value the decl denotes the (direct) address
+     of the value.  */
+
+tree
+a68_low_deref (tree exp, NODE_T *p)
+{
+  int num_refs, num_pointers;
+  a68_ref_counts (exp, MOID (p), &num_refs, &num_pointers);
+
+  if (num_refs > num_pointers)
+    return exp;
+  else
+    {
+      gcc_assert (num_refs == num_pointers);
+      return a68_checked_indirect_ref (p, exp, MOID (p));
+    }
+}
+
+/* Get a deep-copy of a given Algol 68 value EXP.  */
+
+tree
+a68_low_dup (tree expr, bool use_heap)
+{
+  tree dup = NULL_TREE;
+  tree type = TREE_TYPE (expr);
+
+  /* XXX */
+  use_heap = true;
+
+  /* Determine the mode corresponding to the type of EXPR.  */
+  MOID_T *m = a68_type_moid (type);
+  gcc_assert (m != NO_MOID);
+  while (EQUIVALENT (m) != NO_MOID)
+    m = EQUIVALENT (m);
+
+  if (A68_ROW_TYPE_P (type))
+    {
+      /* We need to copy the elements as well as the descriptor.  There is no
+	 need to check bounds.  */
+
+      /* Deflexe the mode as appropriate.  */
+      while (IS_FLEX (m))
+	m = SUB (m);
+      gcc_assert (IS_ROW (m) || m == M_STRING);
+
+      a68_push_range (NULL);
+
+      /* First allocate space for the dupped elements.  */
+      expr = save_expr (expr);
+      tree elements = a68_multiple_elements (expr);
+      tree element_pointer_type = TREE_TYPE (elements);
+      tree element_type = TREE_TYPE (element_pointer_type);
+      tree new_elements_size = save_expr (a68_multiple_elements_size (expr));
+      tree new_elements = a68_lower_tmpvar ("new_elements%",
+					    TREE_TYPE (elements),
+					    (use_heap
+					     ? a68_lower_malloc (TREE_TYPE (TREE_TYPE (elements)),
+								 new_elements_size)
+					     : a68_lower_alloca (TREE_TYPE (TREE_TYPE (elements)),
+								 new_elements_size)));
+
+      /* Then copy the elements.
+
+	 If the mode of the elements stored in the multiple dont have rows,
+	 then we can just use memcpy.  Otherwise, we have to loop and recurse
+	 to dup all the elements in the multiple one by one.
+
+	 The above applies to multiples of any number of dimensions.  */
+      if (m == M_STRING || !HAS_ROWS (SUB (m)))
+	{
+	  a68_add_stmt (a68_lower_memcpy (new_elements,
+					  elements,
+					  new_elements_size));
+	  a68_add_stmt (new_elements);
+	}
+      else
+	{
+	  /* Note that num_elems includes elements that are not accessible due
+	     to trimming.  */
+	  tree num_elems = a68_lower_tmpvar ("numelems%", size_type_node,
+					     fold_build2 (TRUNC_DIV_EXPR, sizetype,
+							  new_elements_size,
+							  size_in_bytes (element_type)));
+	  tree orig_elements = a68_lower_tmpvar ("orig_elements%",
+						 element_pointer_type, elements);
+	  tree index = a68_lower_tmpvar ("index%", size_type_node, size_zero_node);
+
+	  /* Begin of loop body.  */
+	  a68_push_range (NULL);
+
+	  /* if (index == num_elems) break; */
+	  a68_add_stmt (fold_build1 (EXIT_EXPR,
+				     void_type_node,
+				     fold_build2 (EQ_EXPR,
+						  size_type_node,
+						  index, num_elems)));
+	  /* new_elements[index] = elements[index] */
+	  tree offset = fold_build2 (MULT_EXPR, sizetype,
+				     index, size_in_bytes (element_type));
+	  tree new_elem_lvalue = fold_build2 (MEM_REF, element_type,
+					      fold_build2 (POINTER_PLUS_EXPR,
+							   element_pointer_type,
+							   new_elements,
+							   offset),
+					      fold_convert (element_pointer_type,
+							    integer_zero_node));
+	  tree elem = fold_build2 (MEM_REF, element_type,
+				   fold_build2 (POINTER_PLUS_EXPR,
+						element_pointer_type,
+						orig_elements,
+						offset),
+				   fold_convert (element_pointer_type,
+						 integer_zero_node));
+	  a68_add_stmt (fold_build2 (MODIFY_EXPR, element_type,
+				     new_elem_lvalue,
+				     a68_low_dup (elem, use_heap)));
+	  /* index++ */
+	  a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR,
+				     size_type_node,
+				     index, size_one_node));
+	  tree loop_body = a68_pop_range ();
+	  /* End of loop body.  */
+
+	  a68_add_stmt (fold_build1 (LOOP_EXPR,
+				     void_type_node,
+				     loop_body));
+	  a68_add_stmt (new_elements);
+	}
+
+      new_elements = a68_pop_range ();
+      TREE_TYPE (new_elements) = element_pointer_type;
+
+      /* Now build a descriptor pointing to the dupped elements and return it.
+	 Note that the descriptor is always allocated on the stack.  */
+      dup = a68_row_value_raw (type,
+			       a68_multiple_triplets (expr),
+			       new_elements,
+			       new_elements_size);
+    }
+  else if (!HAS_ROWS (m))
+    {
+      /* Non-multiple values that do not contain rows do not need to be dupped,
+	 since they can be just moved around using the semantics of
+	 MODIFY_EXPR.  */
+      dup = expr;
+    }
+  else if (A68_STRUCT_TYPE_P (type))
+    {
+      /* Since struct value can contain multiples and unions and other values
+	 that require deep copy, we cannot simply rely on the C semantics of a
+	 MODIFY_EXPR.  */
+      tree struct_type = type;
+      vec <constructor_elt, va_gc> *ce = NULL;
+
+      expr = save_expr (expr);
+      for (tree field = TYPE_FIELDS (struct_type);
+	   field;
+	   field = TREE_CHAIN (field))
+	{
+	  CONSTRUCTOR_APPEND_ELT (ce, field,
+				  a68_low_dup (fold_build3 (COMPONENT_REF,
+							    TREE_TYPE (field),
+							    expr,
+							    field,
+							    NULL_TREE),
+					       use_heap));
+	}
+      dup = build_constructor (struct_type, ce);
+    }
+  else if (A68_UNION_TYPE_P (type))
+    {
+      /* We need to recurse in whatever type corresponding to the active mode
+	 in the united value.  This shall be done at run-time by using a series
+	 of
+
+	   IF overhead IS index of mode blah in union
+	   THEN dup = dup_type (CTYPE (mode blah in union))
+	   FI
+      */
+
+      MOID_T *union_mode = a68_type_moid (type);
+
+      a68_push_range (union_mode);
+      dup = a68_lower_tmpvar ("dup%", type, expr);
+
+      tree cunion_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)));
+      tree field_decl = TYPE_FIELDS (cunion_type);
+      while (EQUIVALENT (union_mode) != NO_MOID)
+	union_mode = EQUIVALENT (union_mode);
+      for (PACK_T *pack = PACK (union_mode); pack != NO_PACK; FORWARD (pack))
+	{
+	  tree continue_label_decl = build_decl (UNKNOWN_LOCATION,
+						 LABEL_DECL,
+						 NULL, /* Set below.  */
+						 void_type_node);
+	  char *label_name = xasprintf ("continue%d%%", DECL_UID (continue_label_decl));
+	  DECL_NAME (continue_label_decl) = get_identifier (label_name);
+	  free (label_name);
+
+	  a68_add_decl (continue_label_decl);
+
+	  a68_add_stmt (fold_build2 (TRUTH_ORIF_EXPR,
+				     integer_type_node,
+				     fold_build2 (EQ_EXPR,
+						  integer_type_node,
+						  a68_union_overhead (dup),
+						  size_int (a68_united_mode_index (union_mode, MOID (pack)))),
+				     fold_build2 (COMPOUND_EXPR,
+						  integer_type_node,
+						  build1 (GOTO_EXPR, void_type_node, continue_label_decl),
+						  integer_zero_node)));
+	  a68_add_stmt (fold_build2 (MODIFY_EXPR, type,
+				     fold_build3 (COMPONENT_REF,
+						  TREE_TYPE (field_decl),
+						  a68_union_cunion (dup),
+						  field_decl,
+						  NULL_TREE),
+				     a68_low_dup (fold_build3 (COMPONENT_REF,
+							       TREE_TYPE (field_decl),
+							       a68_union_cunion (dup),
+							       field_decl,
+							       NULL_TREE),
+						  use_heap)));
+	  a68_add_stmt (build1 (LABEL_EXPR, void_type_node, continue_label_decl));
+	  field_decl = TREE_CHAIN (field_decl);
+	}
+
+      a68_add_stmt (dup);
+      dup = a68_pop_range ();
+    }
+  else
+    /* Not an Algol 68 value.  */
+    gcc_unreachable ();
+
+  return dup;
+}
+
+/* Lower code to ascribe the value yielded by the expression in RHS to the
+   defining identifier implied by the LHS, which is a VAR_DECL tree.  MODE is
+   the mode of the value to be ascribed.  */
+
+tree
+a68_low_ascription (MOID_T *mode, tree lhs, tree rhs)
+{
+  gcc_assert (VAR_P (lhs));
+
+  tree type = CTYPE (mode);
+  if (IS (mode, PROC_SYMBOL))
+    {
+      /* A pointer to a function, or a function, is expected at the right hand
+	 side.  We need a pointer for the left hand side..  */
+      if (TREE_CODE (TREE_TYPE (rhs)) == FUNCTION_TYPE)
+	{
+	  type = build_pointer_type (type);
+	  rhs = fold_build1 (ADDR_EXPR, type, rhs);
+	}
+    }
+
+  if (HAS_ROWS (mode))
+    rhs = a68_low_dup (rhs);
+  return fold_build2 (MODIFY_EXPR, type, lhs, rhs);
+}
+
+/* Perform an assignation of RHS to LHS.
+
+   MODE_RHS is the mode of the rhs.
+   MODE_LHS is the mode of the lhs.
+
+   MODE_LHS shall be REF [FLEX] MODE_LHS.  */
+
+tree
+a68_low_assignation (NODE_T *p,
+		     tree lhs, MOID_T *mode_lhs,
+		     tree rhs, MOID_T *mode_rhs)
+{
+  NODE_T *lhs_node = SUB (p);
+  tree assignation = NULL_TREE;
+  tree orig_rhs = rhs;
+
+  if (IS_FLEXETY_ROW (mode_rhs))
+    {
+      /* Make a deep copy of the rhs.  Note that we have to use the heap
+	 because the scope of the lhs may be older than the scope of the rhs.
+	 XXX this can be ommitted if a68_multiple_copy_elems below supports
+	 overlapping multiples.  */
+      if (HAS_ROWS (mode_rhs))
+	rhs = a68_low_dup (rhs, true /* use_heap */);
+      rhs = save_expr (rhs);
+
+      /* Determine whether the REF [FLEX] MODE_LHS is flexible.  */
+      if (SUB (mode_lhs) == M_STRING || IS_FLEX (SUB (mode_lhs)))
+	{
+	  /* Assigning to a flexible name updates descriptor with new bounds
+	     and also sets the elements to the dup of the rhs.  No boundscheck
+	     is peformed.  XXX but bound checking in contained values may be
+	     necessary, ghost elements.  */
+	  if (POINTER_TYPE_P (TREE_TYPE (lhs))
+	      && TREE_TYPE (TREE_TYPE (lhs)) == TREE_TYPE (rhs))
+	    {
+	      /* Make sure to not evaluate the expression yielding the pointer
+		 more than once.  */
+	      lhs = save_expr (lhs);
+	      tree deref_lhs = a68_checked_indirect_ref (lhs_node, lhs, mode_lhs);
+	      assignation = fold_build2 (COMPOUND_EXPR,
+					 TREE_TYPE (lhs),
+					 fold_build2 (MODIFY_EXPR, TREE_TYPE (lhs),
+						      deref_lhs, rhs),
+					 lhs);
+	    }
+	  else
+	    {
+	      /* The lhs is either a variable or a component ref as a l-value.  It
+		 is ok to evaluate it as an r-value as well as doing so inroduces
+		 no side-effects.  */
+	      assignation = fold_build2 (COMPOUND_EXPR,
+					 TREE_TYPE (lhs),
+					 fold_build2 (MODIFY_EXPR, TREE_TYPE (lhs),
+						      lhs, rhs),
+					 lhs);
+	    }
+	}
+      else
+	{
+	  /* Dereference the multiple at the left-hand side.  This may require
+	     indirection.  */
+
+	  tree effective_lhs;
+	  if (POINTER_TYPE_P (TREE_TYPE (lhs)))
+	    {
+	      /* The name at the lhs is a pointer.  */
+	      gcc_assert (TREE_TYPE (TREE_TYPE (lhs)) == TREE_TYPE (rhs));
+	      lhs = save_expr (lhs);
+	      effective_lhs = a68_checked_indirect_ref (lhs_node, lhs, mode_lhs);
+	    }
+	  else
+	    {
+	      /* The name at the lhs is either a variable or a component ref as
+		 a l-value.  It is ok to evaluate it as an r-value as well as
+		 doing so introduces no side-effects.  */
+	      effective_lhs = lhs;
+	    }
+
+	  /* Copy over the elements in a loop.  The space occupied by the
+	     previous elements stored in the lhs multiple will be recovered by
+	     either stack shrinkage or garbage collected.  */
+	  tree copy_elements = a68_multiple_copy_elems (mode_rhs, effective_lhs, rhs);
+	  assignation = fold_build2 (COMPOUND_EXPR,
+				     TREE_TYPE (lhs),
+				     copy_elements,
+				     lhs);
+
+	  /* Check the bounds of the multiple at the rhs to make sure they are
+	     the same than the bounds of the multiple already referred by the
+	     lhs.  If the bounds don't match then emit a run-time error.  */
+	  if (OPTION_BOUNDS_CHECKING (&A68_JOB))
+	    assignation = fold_build2 (COMPOUND_EXPR,
+				       TREE_TYPE (assignation),
+				       a68_multiple_bounds_check_equal (p,
+									effective_lhs,
+									rhs),
+				       assignation);
+
+	}
+    }
+  else
+    {
+      /* First make sure we got a pointer in the RHS in case it is a name.  */
+      rhs = a68_consolidate_ref (mode_rhs, rhs);
+
+      /* The assignation implies copying the entire value being assigned, so
+	 make sure we do a deep copy whenever needed.  Note that we have to use
+	 the heap because the scope of the lhs may be older than the scope of
+	 the rhs.  */
+      if (HAS_ROWS (mode_rhs))
+	rhs = a68_low_dup (rhs, true /* use_heap */);
+
+      if (POINTER_TYPE_P (TREE_TYPE (lhs))
+	  && TREE_TYPE (TREE_TYPE (lhs)) == TREE_TYPE (rhs))
+	{
+	  /* If the left hand side is a pointer, deref it, but return the
+	     pointer.  Make sure to not evaluate the expression yielding the
+	     pointer more than once.  */
+	  lhs = save_expr (lhs);
+	  tree deref_lhs = a68_checked_indirect_ref (lhs_node, lhs, mode_lhs);
+	  assignation = fold_build2 (COMPOUND_EXPR,
+				     TREE_TYPE (lhs),
+				     fold_build2 (MODIFY_EXPR, TREE_TYPE (lhs),
+						  deref_lhs, rhs),
+				     lhs);
+	}
+      else
+	{
+	  /* Otherwise the lhs is either a variable or a component ref as an
+	     l-value.  It is ok to evaluate it as an r-value as well as doing
+	     so introduces no side-effects.  */
+	  assignation = fold_build2 (COMPOUND_EXPR,
+				     TREE_TYPE (lhs),
+				     fold_build2 (MODIFY_EXPR, TREE_TYPE (lhs),
+						  lhs, rhs),
+				     lhs);
+	}
+    }
+
+  /* Since it is been assigned to a name, the rhs is no longer constant.  */
+  if (A68_ROW_TYPE_P (TREE_TYPE (orig_rhs)) || A68_STRUCT_TYPE_P (TREE_TYPE (orig_rhs)))
+    TREE_CONSTANT (orig_rhs) = 0;
+  return assignation;
+}
+
+/* Build a tree that copies SIZE bytes from SRC into DST.  */
+
+tree
+a68_lower_memcpy (tree dst, tree src, tree size)
+{
+  return build_call_expr (builtin_decl_explicit (BUILT_IN_MEMCPY), 3,
+			  dst, src, size);
+}
+
+/* Build a tree that allocates SIZE bytes on the stack and returns a *TYPE
+   pointer to it.  */
+
+tree
+a68_lower_alloca (tree type, tree size)
+{
+  tree call = builtin_decl_explicit (BUILT_IN_ALLOCA_WITH_ALIGN);
+  call = build_call_expr_loc (UNKNOWN_LOCATION, call, 2,
+			      size,
+			      size_int (TYPE_ALIGN (type)));
+  call = fold_convert (build_pointer_type (type), call);
+  return call;
+}
+
+
+/* Build a tree that allocates SIZE bytes on the heap and returns a *TYPE
+   pointer to it.  */
+
+tree
+a68_lower_malloc (tree type, tree size)
+{
+  return fold_convert (build_pointer_type (type),
+		       a68_build_libcall (A68_LIBCALL_MALLOC, ptr_type_node,
+					  1, size));
+}
+
+/* Build code for a temporary variable named NAME, of type TYPE and initialized
+   to INIT.  Returns the decl node for the temporary.  */
+
+tree
+a68_lower_tmpvar (const char *name, tree type, tree init)
+{
+  tree tmpvar = build_decl (UNKNOWN_LOCATION,
+			    VAR_DECL,
+			    get_identifier (name),
+			    type);
+  DECL_ARTIFICIAL (tmpvar) = 1;
+  DECL_IGNORED_P (tmpvar) = 1;
+  a68_add_decl (tmpvar);
+  a68_add_decl_expr (fold_build1 (DECL_EXPR, type, tmpvar));
+  a68_add_stmt (fold_build2 (INIT_EXPR, type, tmpvar, init));
+  return tmpvar;
+}
+
+/* Build a FUNC_DECL for a top-level non-public function and return it.  */
+
+tree
+a68_low_toplevel_func_decl (const char *name, tree fntype)
+{
+  tree fndecl = build_decl (UNKNOWN_LOCATION,
+			    FUNCTION_DECL,
+			    NULL /* set below */,
+			    fntype);
+  char *_name = xasprintf ("__ga68_%s%d", name, DECL_UID (fndecl));
+  DECL_NAME (fndecl) = get_identifier (_name);
+  free (_name);
+  DECL_EXTERNAL (fndecl) = 0;
+  TREE_PUBLIC (fndecl) = 0;
+  TREE_STATIC (fndecl) = 1;
+
+  return fndecl;
+}
+
+/* Build a PARM_DECL whose context is TYPE with the given NAME.  */
+
+tree
+a68_low_func_param (tree fndecl, const char *name, tree type)
+{
+  tree param = build_decl (UNKNOWN_LOCATION, PARM_DECL,
+			   get_identifier (name), type);
+  DECL_CONTEXT (param) = fndecl;
+  DECL_ARG_TYPE (param) = TREE_TYPE (param);
+  layout_decl (param, 0);
+  return param;
+}
+
+/* Lower a particular program.
+
+     particular program : label, enclosed clause; enclosed clause.
+
+   This handler always returns NULL_TREE.  */
+
+static tree
+lower_particular_program (NODE_T *p,
+			  LOW_CTX_T ctx ATTRIBUTE_UNUSED)
+{
+  /* Create the main function that conforms the particular program.  */
+  tree main_decl = build_decl (a68_get_node_location (p),
+			       FUNCTION_DECL,
+			       get_identifier ("__algol68_main"),
+			       build_function_type (void_type_node,
+						    void_list_node));
+  DECL_EXTERNAL (main_decl) = 0;
+  TREE_PUBLIC (main_decl) = 1;
+  TREE_STATIC (main_decl) = 1;
+
+  a68_push_function_range (main_decl,
+			   void_type_node /* result_type */);
+
+  /* Lower the body of the function.  */
+  NODE_T *enclosed_clause = (IS (SUB (p), ENCLOSED_CLAUSE)
+			     ? SUB (p) : NEXT (SUB (p)));
+  tree body_expr = a68_lower_tree (enclosed_clause, ctx);
+  a68_pop_function_range (body_expr);
+  return NULL_TREE;
+}
+
+/* Lower the given tree P using the given context CTX.  */
+
+tree
+a68_lower_tree (NODE_T *p, LOW_CTX_T ctx)
+{
+#if 0
+  for (int i = 0; i < ctx.level; ++i)
+    printf (" ");
+  printf ("LOWER TREE: %d::%s\n",
+  	  NUMBER (p), a68_attribute_name (ATTRIBUTE (p)));
+#endif
+  ctx.level++;
+
+  tree res = NULL_TREE;
+
+  if (p == NO_NODE)
+    gcc_unreachable ();
+
+  switch (ATTRIBUTE (p))
+    {
+    case PARTICULAR_PROGRAM:
+      res = lower_particular_program (p, ctx);
+      break;
+      /* Clauses */
+    case ENCLOSED_CLAUSE:
+      res = a68_lower_enclosed_clause (p, ctx);
+      break;
+    case CLOSED_CLAUSE:
+      res = a68_lower_closed_clause (p, ctx);
+      break;
+    case PARALLEL_CLAUSE:
+      res = a68_lower_parallel_clause (p, ctx);
+      break;
+    case COLLATERAL_CLAUSE:
+      res = a68_lower_collateral_clause (p, ctx);
+      break;
+    case UNIT_LIST:
+      res = a68_lower_unit_list (p, ctx);
+      break;
+    case CONDITIONAL_CLAUSE:
+      res = a68_lower_conditional_clause (p, ctx);
+      break;
+    case ENQUIRY_CLAUSE:
+      res = a68_lower_enquiry_clause (p, ctx);
+      break;
+    case CASE_CLAUSE:
+      res = a68_lower_case_clause (p, ctx);
+      break;
+    case CONFORMITY_CLAUSE:
+      res = a68_lower_conformity_clause (p, ctx);
+      break;
+    case LOOP_CLAUSE:
+      res = a68_lower_loop_clause (p, ctx);
+      break;
+    case SERIAL_CLAUSE:
+      res = a68_lower_serial_clause (p, ctx);
+      break;
+    case INITIALISER_SERIES:
+      res = a68_lower_initialiser_series (p, ctx);
+      break;
+    case EXIT_SYMBOL:
+      res = a68_lower_completer (p, ctx);
+      break;
+    case LABELED_UNIT:
+      res = a68_lower_labeled_unit (p, ctx);
+      break;
+    case LABEL:
+      res = a68_lower_label (p, ctx);
+      break;
+      /* Declarations.  */
+    case DECLARATION_LIST:
+      res = a68_lower_declaration_list (p, ctx);
+      break;
+    case DECLARER:
+      res = a68_lower_declarer (p, ctx);
+      break;
+    case IDENTITY_DECLARATION:
+      res = a68_lower_identity_declaration (p, ctx);
+      break;
+    case VARIABLE_DECLARATION:
+      res = a68_lower_variable_declaration (p, ctx);
+      break;
+    case PROCEDURE_DECLARATION:
+      res = a68_lower_procedure_declaration (p, ctx);
+      break;
+    case PROCEDURE_VARIABLE_DECLARATION:
+      res = a68_lower_procedure_variable_declaration (p, ctx);
+      break;
+    case PRIORITY_DECLARATION:
+      res = a68_lower_priority_declaration (p, ctx);
+      break;
+    case BRIEF_OPERATOR_DECLARATION:
+      res = a68_lower_brief_operator_declaration (p, ctx);
+      break;
+    case OPERATOR_DECLARATION:
+      res = a68_lower_operator_declaration (p, ctx);
+      break;
+    case MODE_DECLARATION:
+      res = a68_lower_mode_declaration (p, ctx);
+      break;
+      /* Units. */
+    case UNIT:
+      res = a68_lower_unit (p, ctx);
+      break;
+    case ROUTINE_TEXT:
+      res = a68_lower_routine_text (p, ctx);
+      break;
+    case ASSIGNATION:
+      res = a68_lower_assignation (p, ctx);
+      break;
+    case TERTIARY:
+      res = a68_lower_tertiary (p, ctx);
+      break;
+    case MONADIC_FORMULA:
+      res = a68_lower_monadic_formula (p, ctx);
+      break;
+    case FORMULA:
+      res = a68_lower_formula (p, ctx);
+      break;
+    case SECONDARY:
+      res = a68_lower_secondary (p, ctx);
+      break;
+    case SLICE:
+      res = a68_lower_slice (p, ctx);
+      break;
+    case SELECTION:
+      res = a68_lower_selection (p, ctx);
+      break;
+    case PRIMARY:
+      res = a68_lower_primary (p, ctx);
+      break;
+    case GENERATOR:
+      res = a68_lower_generator (p, ctx);
+      break;
+    case CALL:
+      res = a68_lower_call (p, ctx);
+      break;
+    case CAST:
+      res = a68_lower_cast (p, ctx);
+      break;
+    case AND_FUNCTION:
+    case OR_FUNCTION:
+      res = a68_lower_logic_function (p, ctx);
+      break;
+    case IDENTITY_RELATION:
+      res = a68_lower_identity_relation (p, ctx);
+      break;
+    case EMPTY_SYMBOL:
+      res = a68_lower_empty (p, ctx);
+      break;
+    case NIHIL:
+      res = a68_lower_nihil (p, ctx);
+      break;
+    case SKIP:
+      res = a68_lower_skip (p, ctx);
+      break;
+    case DENOTATION:
+      res = a68_lower_denotation (p, ctx);
+      break;
+    case IDENTIFIER:
+      res = a68_lower_identifier (p, ctx);
+      break;
+      /* Coercions.  */
+    case ROWING:
+      res = a68_lower_rowing (p, ctx);
+      break;
+    case WIDENING:
+      res = a68_lower_widening (p, ctx);
+      break;
+    case DEPROCEDURING:
+      res = a68_lower_deproceduring (p, ctx);
+      break;
+    case PROCEDURING:
+      res = a68_lower_proceduring (p, ctx);
+      break;
+    case VOIDING:
+      res = a68_lower_voiding (p, ctx);
+      break;
+    case DEREFERENCING:
+      res = a68_lower_dereferencing (p, ctx);
+      break;
+      /* Others. */
+    case UNITING:
+      res = a68_lower_uniting (p, ctx);
+      break;
+    case JUMP:
+      res = a68_lower_jump (p, ctx);
+      break;
+    case PARAMETER:
+      res = a68_lower_parameter (p, ctx);
+      break;
+    case PARAMETER_LIST:
+      res = a68_lower_parameter_list (p, ctx);
+      break;
+    case PARAMETER_PACK:
+      res = a68_lower_parameter_pack (p, ctx);
+      break;
+    case OPERATOR:
+      res = a68_lower_operator (p, ctx);
+      break;
+    case ASSERTION:
+      res = a68_lower_assertion (p, ctx);
+      break;
+    case STOP:
+      res = NULL_TREE;
+      break;
+    default:
+      fatal_error (a68_get_node_location (p), "cannot lower node %s",
+		   a68_attribute_name (ATTRIBUTE (p)));
+      gcc_unreachable ();
+      break;
+    }
+
+  return res;
+}
+
+/* Lower an Algol 68 complete parse tree to a GENERIC tree.  */
+
+tree
+a68_lower_top_tree (NODE_T *p)
+{
+  LOW_CTX_T top_ctx;
+
+  top_ctx.declarer = NULL;
+  top_ctx.proc_decl_identifier = NO_NODE;
+  top_ctx.level = 0;
+  return a68_lower_tree (p, top_ctx);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-moids-diagnostics.cc
@@ -0,0 +1,269 @@
+/* MOID diagnostics routines.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "options.h"
+
+#include "a68.h"
+
+/* Give accurate error message.  */
+
+char *
+a68_mode_error_text (NODE_T *n, MOID_T *p, MOID_T *q, int context, int deflex, int depth)
+{
+#define TAIL(z) (&(z)[strlen (z)])
+  static BUFFER txt;
+  if (depth == 1)
+    txt[0] = '\0';
+  if (IS (p, SERIES_MODE))
+    {
+      PACK_T *u = PACK (p);
+
+      int N = 0;
+      if (u == NO_PACK)
+	{
+	  if (snprintf (txt, SNPRINTF_SIZE, "empty mode-list") < 0)
+	    gcc_unreachable ();
+	  N++;
+	}
+      else
+	{
+	  for (; u != NO_PACK; FORWARD (u))
+	    {
+	      if (MOID (u) != NO_MOID)
+		{
+		  if (IS (MOID (u), SERIES_MODE))
+		    (void) a68_mode_error_text (n, MOID (u), q, context, deflex, depth + 1);
+		  else if (!a68_is_coercible (MOID (u), q, context, deflex))
+		    {
+		      size_t len = strlen (txt);
+		      if (len > BUFFER_SIZE / 2)
+			{
+			  if (snprintf (TAIL (txt), SNPRINTF_SIZE, " etcetera") < 0)
+			    gcc_unreachable ();
+			  N++;
+			}
+		      else
+			{
+			  if (strlen (txt) > 0)
+			    {
+			      if (snprintf (TAIL (txt), SNPRINTF_SIZE, " and ") < 0)
+				gcc_unreachable ();
+			      N++;
+			    }
+			  if (snprintf (TAIL (txt), SNPRINTF_SIZE, "%s",
+					a68_moid_to_string (MOID (u), MOID_ERROR_WIDTH, n)) < 0)
+			    gcc_unreachable ();
+			  N++;
+			}
+		    }
+		}
+	    }
+	}
+      if (depth == 1)
+	{
+	  if (N == 0)
+	    {
+	      if (snprintf (TAIL (txt), SNPRINTF_SIZE, "mode") < 0)
+		gcc_unreachable ();
+	    }
+	  if (snprintf (TAIL (txt), SNPRINTF_SIZE, " cannot be coerced to %s",
+			a68_moid_to_string (q, MOID_ERROR_WIDTH, n)) < 0)
+	    gcc_unreachable ();
+	}
+    }
+  else if (IS (p, STOWED_MODE) && IS_FLEX (q))
+    {
+      PACK_T *u = PACK (p);
+
+      if (u == NO_PACK)
+	{
+	  if (snprintf (txt, SNPRINTF_SIZE, "empty mode-list") < 0)
+	    gcc_unreachable ();
+	}
+      else
+	{
+	  for (; u != NO_PACK; FORWARD (u))
+	    {
+	      if (!a68_is_coercible (MOID (u), SLICE (SUB (q)), context, deflex))
+		{
+		  size_t len = strlen (txt);
+		  if (len > BUFFER_SIZE / 2)
+		    {
+		      if (snprintf (TAIL (txt), SNPRINTF_SIZE, " etcetera") < 0)
+			gcc_unreachable ();
+		    }
+		  else
+		    {
+		      if (strlen (txt) > 0)
+			{
+			  if (snprintf (TAIL (txt), SNPRINTF_SIZE, " and ") < 0)
+			    gcc_unreachable ();
+			}
+		      if (snprintf (TAIL (txt), SNPRINTF_SIZE, "%s",
+				    a68_moid_to_string (MOID (u), MOID_ERROR_WIDTH, n)) < 0)
+			gcc_unreachable ();
+		    }
+		}
+	    }
+	  if (snprintf (TAIL (txt), SNPRINTF_SIZE, " cannot be coerced to %s",
+			a68_moid_to_string (SLICE (SUB (q)), MOID_ERROR_WIDTH, n)) < 0)
+	    gcc_unreachable ();
+	}
+    }
+  else if (IS (p, STOWED_MODE) && IS (q, ROW_SYMBOL))
+    {
+      PACK_T *u = PACK (p);
+
+      if (u == NO_PACK)
+	{
+	  if (snprintf (txt, SNPRINTF_SIZE, "empty mode-list") < 0)
+	    gcc_unreachable ();
+	}
+      else
+	{
+	  for (; u != NO_PACK; FORWARD (u))
+	    {
+	      if (!a68_is_coercible (MOID (u), SLICE (q), context, deflex))
+		{
+		  size_t len = strlen (txt);
+		  if (len > BUFFER_SIZE / 2)
+		    {
+		      if (snprintf (TAIL (txt), SNPRINTF_SIZE, " etcetera") < 0)
+			gcc_unreachable ();
+		    }
+		  else
+		    {
+		      if (strlen (txt) > 0)
+			{
+			  if (snprintf (TAIL (txt), SNPRINTF_SIZE, " and ") < 0)
+			    gcc_unreachable ();
+			}
+		      if (snprintf (TAIL (txt), SNPRINTF_SIZE, "%s",
+				    a68_moid_to_string (MOID (u), MOID_ERROR_WIDTH, n)) < 0)
+			gcc_unreachable ();
+		    }
+		}
+	    }
+	  if (snprintf (TAIL (txt), SNPRINTF_SIZE, " cannot be coerced to %s",
+			a68_moid_to_string (SLICE (q), MOID_ERROR_WIDTH, n)) < 0)
+	    gcc_unreachable ();
+	}
+    }
+  else if (IS (p, STOWED_MODE) && (IS (q, PROC_SYMBOL) || IS (q, STRUCT_SYMBOL)))
+    {
+      PACK_T *u = PACK (p), *v = PACK (q);
+
+      if (u == NO_PACK)
+	{
+	  if (snprintf (txt, SNPRINTF_SIZE, "empty mode-list") < 0)
+	    gcc_unreachable ();
+	}
+      else
+	{
+	  for (; u != NO_PACK && v != NO_PACK; FORWARD (u), FORWARD (v))
+	    {
+	      if (!a68_is_coercible (MOID (u), MOID (v), context, deflex))
+		{
+		  size_t len = strlen (txt);
+		  if (len > BUFFER_SIZE / 2)
+		    {
+		      if (snprintf (TAIL (txt), SNPRINTF_SIZE, " etcetera") < 0)
+			gcc_unreachable ();
+		    }
+		  else
+		    {
+		      if (strlen (txt) > 0)
+			{
+			  if (snprintf (TAIL (txt), SNPRINTF_SIZE, " and ") < 0)
+			    gcc_unreachable ();
+			}
+		      if (snprintf (TAIL (txt), SNPRINTF_SIZE, "%s cannot be coerced to %s",
+				    a68_moid_to_string (MOID (u), MOID_ERROR_WIDTH, n),
+				    a68_moid_to_string (MOID (v), MOID_ERROR_WIDTH, n)) < 0)
+			gcc_unreachable ();
+		    }
+		}
+	    }
+	}
+    }
+  return txt;
+#undef TAIL
+}
+
+/* Cannot coerce error.  */
+
+void
+a68_cannot_coerce (NODE_T *p, MOID_T *from, MOID_T *to, int context, int deflex, int att)
+{
+  char *txt = a68_mode_error_text (p, from, to, context, deflex, 1);
+
+  if (att == STOP)
+    {
+      if (strlen (txt) == 0)
+	a68_error (p, "M cannot be coerced to M in C context", from, to, context);
+      else
+	a68_error (p, "Y in C context", txt, context);
+    }
+  else
+    {
+      if (strlen (txt) == 0)
+	a68_error (p, "M cannot be coerced to M in C-A", from, to, context, att);
+      else
+	a68_error (p, "Y in C-A", txt, context, att);
+    }
+}
+
+/* Give a warning when a value is silently discarded.  */
+
+void
+a68_warn_for_voiding (NODE_T *p, SOID_T *x, SOID_T *y, int c)
+{
+  (void) c;
+
+  if (CAST (x) == false)
+    {
+      if (MOID (x) == M_VOID && MOID (y) != M_ERROR && !(MOID (y) == M_VOID || !a68_is_nonproc (MOID (y))))
+	{
+	  if (IS (p, FORMULA))
+	    a68_warning (p, OPT_Wvoiding, "value of M @ will be voided", MOID (y));
+	  else
+	    a68_warning (p, OPT_Wvoiding, "value of M @ will be voided", MOID (y));
+	}
+    }
+}
+
+/* Warn for things that are likely unintended.  */
+
+void
+a68_semantic_pitfall (NODE_T *p, MOID_T *m, int c, int u)
+{
+  /* semantic_pitfall: warn for things that are likely unintended, for instance
+                       REF INT i := LOC INT := 0, which should probably be
+                       REF INT i = LOC INT := 0.  */
+  if (IS (p, u))
+    a68_warning (p, 0, "possibly unintended M A in M A",
+		 MOID (p), u, m, c);
+  else if (a68_is_one_of (p, UNIT, TERTIARY, SECONDARY, PRIMARY, STOP))
+    a68_semantic_pitfall (SUB (p), m, c, u);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-moids-misc.cc
@@ -0,0 +1,1361 @@
+/* Miscellaneous MOID routines.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "options.h"
+
+#include "a68.h"
+
+/*
+ * MODE checker routines.
+ */
+
+/* Absorb nested series modes recursively.  */
+
+void
+a68_absorb_series_pack (MOID_T **p)
+{
+  bool siga;
+
+  do
+    {
+      PACK_T *z = NO_PACK;
+
+      siga = false;
+      for (PACK_T *t = PACK (*p); t != NO_PACK; FORWARD (t))
+	{
+	  if (MOID (t) != NO_MOID && IS (MOID (t), SERIES_MODE))
+	    {
+	      siga = true;
+	      for (PACK_T *s = PACK (MOID (t)); s != NO_PACK; FORWARD (s))
+		a68_add_mode_to_pack (&z, MOID (s), NO_TEXT, NODE (s));
+	    }
+	  else
+	    a68_add_mode_to_pack (&z, MOID (t), NO_TEXT, NODE (t));
+	}
+      PACK (*p) = z;
+    }
+  while (siga);
+}
+
+/* Make SERIES (u, v).  */
+
+MOID_T *
+a68_make_series_from_moids (MOID_T *u, MOID_T *v)
+{
+  MOID_T *x = a68_new_moid ();
+
+  ATTRIBUTE (x) = SERIES_MODE;
+  a68_add_mode_to_pack (&(PACK (x)), u, NO_TEXT, NODE (u));
+  a68_add_mode_to_pack (&(PACK (x)), v, NO_TEXT, NODE (v));
+  a68_absorb_series_pack (&x);
+  DIM (x) = a68_count_pack_members (PACK (x));
+  (void) a68_register_extra_mode (&TOP_MOID (&A68_JOB), x);
+  if (DIM (x) == 1)
+    return MOID (PACK (x));
+  else
+    return x;
+}
+
+/* Absorb firmly related unions in mode.
+
+   For instance invalid UNION (PROC REF UNION (A, B), A, B) -> valid
+   UNION (A, B), which is used in balancing conformity clauses.  */
+
+MOID_T *
+a68_absorb_related_subsets (MOID_T * m)
+{
+  /* For instance invalid UNION (PROC REF UNION (A, B), A, B) -> valid UNION
+     (A, B), which is used in balancing conformity clauses.  */
+  bool siga;
+
+  do
+    {
+      PACK_T *u = NO_PACK;
+
+      siga = false;
+      for (PACK_T *v = PACK (m); v != NO_PACK; FORWARD (v))
+	{
+	  MOID_T *n = a68_depref_completely (MOID (v));
+
+	  if (IS (n, UNION_SYMBOL) && a68_is_subset (n, m, SAFE_DEFLEXING))
+	    {
+	      /*  Unpack it.  */
+	      for (PACK_T *w = PACK (n); w != NO_PACK; FORWARD (w))
+		a68_add_mode_to_pack (&u, MOID (w), NO_TEXT, NODE (w));
+	      siga = true;
+	    }
+	  else
+	    a68_add_mode_to_pack (&u, MOID (v), NO_TEXT, NODE (v));
+	}
+      PACK (m) = a68_absorb_union_pack (u);
+    }
+  while (siga);
+  return m;
+}
+
+/* Absorb nested series and united modes recursively.  */
+
+void
+a68_absorb_series_union_pack (MOID_T **p)
+{
+  bool siga;
+
+  do
+    {
+      PACK_T *z = NO_PACK;
+
+      siga = false;
+      for (PACK_T *t = PACK (*p); t != NO_PACK; FORWARD (t))
+	{
+	  if (MOID (t) != NO_MOID && (IS (MOID (t), SERIES_MODE) || IS (MOID (t), UNION_SYMBOL)))
+	    {
+	      siga = true;
+	      for (PACK_T *s = PACK (MOID (t)); s != NO_PACK; FORWARD (s))
+		a68_add_mode_to_pack (&z, MOID (s), NO_TEXT, NODE (s));
+	    }
+	  else
+	    a68_add_mode_to_pack (&z, MOID (t), NO_TEXT, NODE (t));
+	}
+      PACK (*p) = z;
+    }
+  while (siga);
+}
+
+/* Make united mode, from mode that is a SERIES (..).  */
+
+MOID_T *
+a68_make_united_mode (MOID_T *m)
+{
+  if (m == NO_MOID)
+    return M_ERROR;
+  else if (ATTRIBUTE (m) != SERIES_MODE)
+    return m;
+
+  /* Do not unite a single UNION.  */
+  if (DIM (m) == 1 && IS (MOID (PACK (m)), UNION_SYMBOL))
+    return MOID (PACK (m));
+
+  /* Straighten the series.  */
+  a68_absorb_series_union_pack (&m);
+  /* Copy the series into a UNION.  */
+  MOID_T *u = a68_new_moid ();
+  ATTRIBUTE (u) = UNION_SYMBOL;
+  PACK (u) = NO_PACK;
+  for (PACK_T *w = PACK (m); w != NO_PACK; FORWARD (w))
+    a68_add_mode_to_pack (&(PACK (u)), MOID (w), NO_TEXT, NODE (m));
+
+  /* Absorb and contract the new UNION.  */
+  a68_absorb_series_union_pack (&u);
+  DIM (u) = a68_count_pack_members (PACK (u));
+  PACK (u) = a68_absorb_union_pack (PACK (u));
+  a68_contract_union (u);
+  DIM (u) = a68_count_pack_members (PACK (u));
+  /* A UNION of one mode is that mode itself.  */
+  if (DIM (u) == 1)
+    return MOID (PACK (u));
+  else
+    return a68_register_extra_mode (&TOP_MOID (&A68_JOB), u);
+}
+
+/* Make SOID data structure.  */
+
+void
+a68_make_soid (SOID_T *s, int sort, MOID_T *type, int attribute)
+{
+  ATTRIBUTE (s) = attribute;
+  SORT (s) = sort;
+  MOID (s) = type;
+  CAST (s) = false;
+}
+
+/* Whether mode is not well defined.  */
+
+bool
+a68_is_mode_isnt_well (MOID_T *p)
+{
+  if (p == NO_MOID)
+    return true;
+  else if (!A68_IF_MODE_IS_WELL (p))
+    return true;
+  else if (PACK (p) != NO_PACK)
+    {
+      for (PACK_T *q = PACK (p); q != NO_PACK; FORWARD (q))
+	{
+	  if (!A68_IF_MODE_IS_WELL (MOID (q)))
+	    return true;
+	}
+    }
+  return false;
+}
+
+/* Add SOID data to free chain.  */
+
+void
+a68_free_soid_list (SOID_T *root)
+{
+  if (root != NO_SOID)
+    {
+      SOID_T *q = root;
+
+      for (; NEXT (q) != NO_SOID; FORWARD (q))
+	;
+      NEXT (q) = A68 (top_soid_list);
+      A68 (top_soid_list) = root;
+    }
+}
+
+/* Add SOID data structure to soid list.  */
+
+void
+a68_add_to_soid_list (SOID_T **root, NODE_T *where, SOID_T *soid)
+{
+  if (*root != NO_SOID)
+    a68_add_to_soid_list (&(NEXT (*root)), where, soid);
+  else
+    {
+      SOID_T *new_one;
+
+      if (A68 (top_soid_list) == NO_SOID)
+	new_one = (SOID_T *) xmalloc (sizeof (SOID_T));
+      else
+	{
+	  new_one = A68 (top_soid_list);
+	  FORWARD (A68 (top_soid_list));
+	}
+
+      a68_make_soid (new_one, SORT (soid), MOID (soid), 0);
+      NODE (new_one) = where;
+      NEXT (new_one) = NO_SOID;
+      *root = new_one;
+    }
+}
+
+/* Pack soids in moid, gather resulting moids from terminators in a clause.  */
+
+MOID_T *
+a68_pack_soids_in_moid (SOID_T *top_sl, int attribute)
+{
+  MOID_T *x = a68_new_moid ();
+  PACK_T *t, **p;
+
+  ATTRIBUTE (x) = attribute;
+  DIM (x) = 0;
+  SUB (x) = NO_MOID;
+  EQUIVALENT (x) = NO_MOID;
+  SLICE (x) = NO_MOID;
+  DEFLEXED (x) = NO_MOID;
+  NAME (x) = NO_MOID;
+  NEXT (x) = NO_MOID;
+  PACK (x) = NO_PACK;
+  p = &(PACK (x));
+  for (; top_sl != NO_SOID; FORWARD (top_sl))
+    {
+      t = a68_new_pack ();
+      MOID (t) = MOID (top_sl);
+      TEXT (t) = NO_TEXT;
+      NODE (t) = NODE (top_sl);
+      NEXT (t) = NO_PACK;
+      DIM (x)++;
+      *p = t;
+      p = &NEXT (t);
+    }
+  (void) a68_register_extra_mode (&TOP_MOID (&A68_JOB), x);
+  return x;
+}
+
+/* Whether P is compatible with Q.  */
+
+bool
+a68_is_equal_modes (MOID_T *p, MOID_T *q, int deflex)
+{
+  if (deflex == FORCE_DEFLEXING)
+    return DEFLEX (p) == DEFLEX (q);
+  else if (deflex == ALIAS_DEFLEXING)
+    {
+      if (IS (p, REF_SYMBOL) && IS (q, REF_SYMBOL))
+	return p == q || DEFLEX (p) == q;
+      else if (!IS (p, REF_SYMBOL) && !IS (q, REF_SYMBOL))
+	return DEFLEX (p) == DEFLEX (q);
+  }
+  else if (deflex == SAFE_DEFLEXING)
+    {
+      if (!IS (p, REF_SYMBOL) && !IS (q, REF_SYMBOL))
+	return DEFLEX (p) == DEFLEX (q);
+    }
+  return p == q;
+}
+
+/* Whether mode is deprefable, i.e. whether it can be either deferred or
+   deprocedured.  */
+
+bool
+a68_is_deprefable (MOID_T *p)
+{
+  if (IS_REF (p))
+    return true;
+  else
+    return (IS (p, PROC_SYMBOL) && PACK (p) == NO_PACK);
+}
+
+/* Deref or deproc the mode P once.  */
+
+MOID_T *
+a68_depref_once (MOID_T *p)
+{
+  if (IS_REF_FLEX (p))
+    return SUB_SUB (p);
+  else if (IS_REF (p))
+    return SUB (p);
+  else if (IS (p, PROC_SYMBOL) && PACK (p) == NO_PACK)
+    return SUB (p);
+  else
+    return NO_MOID;
+}
+
+/* Depref mode completely.  */
+
+MOID_T *
+a68_depref_completely (MOID_T *p)
+{
+  while (a68_is_deprefable (p))
+    p = a68_depref_once (p);
+  return p;
+}
+
+/* Deproc_completely.  */
+
+MOID_T *
+a68_deproc_completely (MOID_T *p)
+{
+  while (IS (p, PROC_SYMBOL) && PACK (p) == NO_PACK)
+    p = a68_depref_once (p);
+  return p;
+}
+
+/* Depref rows.  */
+
+MOID_T *
+a68_depref_rows (MOID_T *p, MOID_T *q)
+{
+  if (q == M_ROWS)
+    {
+      while (a68_is_deprefable (p))
+	p = a68_depref_once (p);
+      return p;
+    }
+  else
+    return q;
+}
+
+/* Derow mode, strip FLEX and BOUNDS.  */
+
+MOID_T *
+a68_derow (MOID_T *p)
+{
+  if (IS_ROW (p) || IS_FLEX (p))
+    return a68_derow (SUB (p));
+  else
+    return p;
+}
+
+/* Whether rows type.  */
+
+bool
+a68_is_rows_type (MOID_T *p)
+{
+  switch (ATTRIBUTE (p))
+    {
+    case ROW_SYMBOL:
+    case FLEX_SYMBOL:
+      return true;
+    case UNION_SYMBOL:
+      {
+	PACK_T *t = PACK (p);
+	bool siga = true;
+	while (t != NO_PACK && siga)
+	  {
+	    siga &= a68_is_rows_type (MOID (t));
+	    FORWARD (t);
+	  }
+	return siga;
+      }
+    default:
+      return false;
+    }
+}
+
+/* Whether mode is PROC (REF FILE) VOID or FORMAT.  */
+
+bool
+a68_is_proc_ref_file_void_or_format (MOID_T *p)
+{
+  if (p == M_PROC_REF_FILE_VOID)
+    return true;
+  else if (p == M_FORMAT)
+    return true;
+  else
+    return false;
+}
+
+/* Whether mode can be transput.  */
+
+bool
+a68_is_transput_mode (MOID_T *p, char rw)
+{
+  if (p == M_INT)
+    return true;
+  else if (p == M_SHORT_INT)
+    return true;
+  else if (p == M_SHORT_SHORT_INT)
+    return true;
+  else if (p == M_LONG_INT)
+    return true;
+  else if (p == M_LONG_LONG_INT)
+    return true;
+  else if (p == M_REAL)
+    return true;
+  else if (p == M_LONG_REAL)
+    return true;
+  else if (p == M_LONG_LONG_REAL)
+    return true;
+  else if (p == M_BOOL)
+    return true;
+  else if (p == M_CHAR)
+    return true;
+  else if (p == M_BITS)
+    return true;
+  else if (p == M_SHORT_BITS)
+    return true;
+  else if (p == M_SHORT_SHORT_BITS)
+    return true;
+  else if (p == M_LONG_BITS)
+    return true;
+  else if (p == M_LONG_LONG_BITS)
+    return true;
+  else if (p == M_COMPLEX)
+    return true;
+  else if (p == M_LONG_COMPLEX)
+    return true;
+  else if (p == M_LONG_LONG_COMPLEX)
+    return true;
+  else if (p == M_ROW_CHAR)
+    return true;
+  else if (p == M_STRING)
+    return true;
+  else if (IS (p, UNION_SYMBOL) || IS (p, STRUCT_SYMBOL))
+    {
+      for (PACK_T *q = PACK (p); q != NO_PACK; FORWARD (q))
+	{
+	  if (!(a68_is_transput_mode (MOID (q), rw)
+		|| a68_is_proc_ref_file_void_or_format (MOID (q))))
+	    return false;
+	}
+      return true;
+    }
+  else if (IS_FLEX (p))
+    {
+      if (SUB (p) == M_ROW_CHAR)
+	return true;
+      else
+	return (rw == 'w' ? a68_is_transput_mode (SUB (p), rw) : false);
+    }
+  else if (IS_ROW (p))
+    return (a68_is_transput_mode (SUB (p), rw)
+	    || a68_is_proc_ref_file_void_or_format (SUB (p)));
+  else
+    return false;
+}
+
+/* Whether mode is printable.  */
+
+bool
+a68_is_printable_mode (MOID_T *p)
+{
+  if (a68_is_proc_ref_file_void_or_format (p))
+    return true;
+  else
+    return a68_is_transput_mode (p, 'w');
+}
+
+/* Whether mode is readable.  */
+
+bool
+a68_is_readable_mode (MOID_T *p)
+{
+  if (a68_is_proc_ref_file_void_or_format (p))
+    return true;
+  else if (IS_REF (p))
+    return a68_is_transput_mode (SUB (p), 'r');
+  else if (IS_UNION (p))
+    {
+      for (PACK_T *q = PACK (p); q != NO_PACK; FORWARD (q))
+	{
+	  if (!IS_REF (MOID (q)))
+	    return false;
+	  else if (!a68_is_transput_mode (SUB (MOID (q)), 'r'))
+	    return false;
+	}
+      return true;
+    }
+  else
+    return false;
+}
+
+/* Whether name struct.  */
+
+bool
+a68_is_name_struct (MOID_T *p)
+{
+  return (NAME (p) != NO_MOID ? IS (DEFLEX (SUB (p)), STRUCT_SYMBOL) : false);
+}
+
+/* Yield mode to unite to.  */
+
+MOID_T *
+a68_unites_to (MOID_T *m, MOID_T *u)
+{
+  /* Uniting U (m).  */
+  MOID_T *v = NO_MOID;
+
+  if (u == M_SIMPLIN || u == M_SIMPLOUT)
+    return m;
+
+  for (PACK_T *p = PACK (u); p != NO_PACK; FORWARD (p))
+    {
+      /* Prefer []->[] over []->FLEX [].  */
+      if (m == MOID (p))
+	v = MOID (p);
+      else if (v == NO_MOID && DEFLEX (m) == DEFLEX (MOID (p)))
+	v = MOID (p);
+    }
+  return v;
+}
+
+/* Whether moid in pack.  */
+
+bool
+a68_is_moid_in_pack (MOID_T *u, PACK_T *v, int deflex)
+{
+  for (; v != NO_PACK; FORWARD (v))
+    {
+      if (a68_is_equal_modes (u, MOID (v), deflex))
+	return true;
+    }
+
+  return false;
+}
+
+/* Whether P is a subset of Q.  */
+
+bool
+a68_is_subset (MOID_T *p, MOID_T *q, int deflex)
+{
+  bool j =true;
+
+  for (PACK_T *u = PACK (p); u != NO_PACK && j; FORWARD (u))
+    j = (j && a68_is_moid_in_pack (MOID (u), PACK (q), deflex));
+
+  return j;
+}
+
+/* Whether P can be united to UNION Q.  */
+
+bool
+a68_is_unitable (MOID_T *p, MOID_T *q, int deflex)
+{
+  if (IS (q, UNION_SYMBOL))
+    {
+      if (IS (p, UNION_SYMBOL))
+	return a68_is_subset (p, q, deflex);
+    else
+      return a68_is_moid_in_pack (p, PACK (q), deflex);
+  }
+
+  return false;
+}
+
+/* Whether all or some components of U can be firmly coerced to a component
+   mode of V..  */
+
+void
+a68_investigate_firm_relations (PACK_T *u, PACK_T *v, bool *all, bool *some)
+{
+  *all = true;
+  *some = true;
+  for (; v != NO_PACK; FORWARD (v))
+    {
+      bool k = false;
+
+      for (PACK_T *w = u; w != NO_PACK; FORWARD (w))
+	k |= a68_is_coercible (MOID (w), MOID (v), FIRM, FORCE_DEFLEXING);
+      *some |= k;
+      *all &= k;
+    }
+}
+
+/* Whether there is a soft path from P to Q.  */
+
+bool
+a68_is_softly_coercible (MOID_T *p, MOID_T *q, int deflex)
+{
+  if (a68_is_equal_modes (p, q, deflex))
+    return true;
+  else if (IS (p, PROC_SYMBOL) && PACK (p) == NO_PACK)
+    return a68_is_softly_coercible (SUB (p), q, deflex);
+  else
+    return false;
+}
+
+/* Whether there is a weak path from P to Q.  */
+
+bool
+a68_is_weakly_coercible (MOID_T * p, MOID_T * q, int deflex)
+{
+  if (a68_is_equal_modes (p, q, deflex))
+    return true;
+  else if (a68_is_deprefable (p))
+    return a68_is_weakly_coercible (a68_depref_once (p), q, deflex);
+  else
+    return false;
+}
+
+/* Whether there is a meek path from P to Q.  */
+
+bool
+a68_is_meekly_coercible (MOID_T *p, MOID_T *q, int deflex)
+{
+  if (a68_is_equal_modes (p, q, deflex))
+    return true;
+  else if (a68_is_deprefable (p))
+    return a68_is_meekly_coercible (a68_depref_once (p), q, deflex);
+  else
+    return false;
+}
+
+/* Whether there is a firm path from P to Q.  */
+
+bool
+a68_is_firmly_coercible (MOID_T *p, MOID_T *q, int deflex)
+{
+  if (a68_is_equal_modes (p, q, deflex))
+    return true;
+  else if (q == M_ROWS && a68_is_rows_type (p))
+    return true;
+  else if (a68_is_unitable (p, q, deflex))
+    return true;
+  else if (a68_is_deprefable (p))
+    return a68_is_firmly_coercible (a68_depref_once (p), q, deflex);
+  else
+    return false;
+}
+
+/* Whether firm.  */
+
+bool
+a68_is_firm (MOID_T *p, MOID_T *q)
+{
+  return (a68_is_firmly_coercible (p, q, SAFE_DEFLEXING)
+	  || a68_is_firmly_coercible (q, p, SAFE_DEFLEXING));
+}
+
+/* Whether P widens to Q.
+
+   This function returns:
+
+   The destination mode Q if P, or
+   Some other mode which is an intermediate step from P to Q, or
+   NO_MOID if P cannot be widened to Q.
+
+   This means that if P is known to widen to Q (a68_is_widenable (P,Q) return
+   true) this function can be invoked repeteadly and it will eventually return
+   Q.  */
+
+MOID_T *
+a68_widens_to (MOID_T *p, MOID_T *q)
+{
+  if (p == M_INT)
+    {
+      if (q == M_REAL || q == M_COMPLEX)
+	{
+	  return M_REAL;
+	}
+      else
+	{
+	  return NO_MOID;
+	}
+    }
+  else if (p == M_LONG_INT)
+    {
+      if (q == M_LONG_REAL)
+	{
+	  return M_LONG_REAL;
+	}
+      else
+	{
+	  return NO_MOID;
+	}
+    }
+  else if (p == M_LONG_LONG_INT)
+    {
+      if (q == M_LONG_LONG_REAL || q == M_LONG_LONG_COMPLEX)
+	  return M_LONG_LONG_REAL;
+      else
+	return NO_MOID;
+    }
+  else if (p == M_REAL)
+    {
+      if (q == M_COMPLEX)
+	{
+	  return M_COMPLEX;
+	}
+      else
+	{
+	  return NO_MOID;
+	}
+    }
+  else if (p == M_LONG_REAL)
+    {
+      if (q == M_LONG_COMPLEX)
+	return M_LONG_COMPLEX;
+      else
+	return NO_MOID;
+    }
+  else if (p == M_LONG_LONG_REAL)
+    {
+      if (q == M_LONG_LONG_COMPLEX)
+	return M_LONG_LONG_COMPLEX;
+      else
+	return NO_MOID;
+    }
+  else if (p == M_BITS)
+    {
+      if (q == M_ROW_BOOL)
+	return M_ROW_BOOL;
+      else if (q == M_FLEX_ROW_BOOL)
+	return M_FLEX_ROW_BOOL;
+      else
+	return NO_MOID;
+    }
+  else if (p == M_SHORT_BITS)
+    {
+      if (q == M_ROW_BOOL)
+	return M_ROW_BOOL;
+      else if (q == M_FLEX_ROW_BOOL)
+	return M_FLEX_ROW_BOOL;
+      else
+	return NO_MOID;
+    }
+  else if (p == M_SHORT_SHORT_BITS)
+    {
+      if (q == M_ROW_BOOL)
+	return M_ROW_BOOL;
+      else if (q == M_FLEX_ROW_BOOL)
+	return M_FLEX_ROW_BOOL;
+      else
+	return NO_MOID;
+    }
+  else if (p == M_LONG_BITS)
+    {
+      if (q == M_ROW_BOOL)
+	return M_ROW_BOOL;
+      else if (q == M_FLEX_ROW_BOOL)
+	return M_FLEX_ROW_BOOL;
+      else
+	return NO_MOID;
+    }
+  else if (p == M_LONG_LONG_BITS)
+    {
+      if (q == M_ROW_BOOL)
+	return M_ROW_BOOL;
+      else if (q == M_FLEX_ROW_BOOL)
+	return M_FLEX_ROW_BOOL;
+      else
+	return NO_MOID;
+    }
+  else if (p == M_BYTES && q == M_ROW_CHAR)
+    return M_ROW_CHAR;
+  else if (p == M_LONG_BYTES && q == M_ROW_CHAR)
+    return M_ROW_CHAR;
+  else if (p == M_BYTES && q == M_FLEX_ROW_CHAR)
+    return M_FLEX_ROW_CHAR;
+  else if (p == M_LONG_BYTES && q == M_FLEX_ROW_CHAR)
+    return M_FLEX_ROW_CHAR;
+  else
+    return NO_MOID;
+}
+
+/* Whether P widens to Q.  */
+
+bool
+a68_is_widenable (MOID_T *p, MOID_T *q)
+{
+  MOID_T *z = a68_widens_to (p, q);
+
+  if (z != NO_MOID)
+    return (z == q ? true : a68_is_widenable (z, q));
+  else
+    return false;
+}
+
+/* Whether P is a REF ROW.  */
+
+bool
+a68_is_ref_row (MOID_T *p)
+{
+  return (NAME (p) != NO_MOID ? IS_ROW (DEFLEX (SUB (p))) : false);
+}
+
+/* Whether strong name.  */
+
+bool
+a68_is_strong_name (MOID_T *p, MOID_T *q)
+{
+  if (p == q)
+    return true;
+  else if (a68_is_ref_row (q))
+    return a68_is_strong_name (p, NAME (q));
+  else
+    return false;
+}
+
+/* Whether strong slice. */
+
+bool
+a68_is_strong_slice (MOID_T *p, MOID_T *q)
+{
+  if (p == q || a68_is_widenable (p, q))
+    return true;
+  else if (SLICE (q) != NO_MOID)
+    return a68_is_strong_slice (p, SLICE (q));
+  else if (IS_FLEX (q))
+    return a68_is_strong_slice (p, SUB (q));
+  else if (a68_is_ref_row (q))
+    return a68_is_strong_name (p, q);
+  else
+    return false;
+}
+
+/* Whether strongly coercible.  */
+
+bool
+a68_is_strongly_coercible (MOID_T *p, MOID_T *q, int deflex)
+{
+  /* Keep this sequence of statements.  */
+  if (a68_is_equal_modes (p, q, deflex))
+    return true;
+  else if (q == M_VOID)
+    return true;
+  else if ((q == M_SIMPLIN || q == M_ROW_SIMPLIN) && a68_is_readable_mode (p))
+    return true;
+  else if (q == M_ROWS && a68_is_rows_type (p))
+    return true;
+  else if (a68_is_unitable (p, a68_derow (q), deflex))
+    return true;
+
+  if (a68_is_ref_row (q) && a68_is_strong_name (p, q))
+    return true;
+  else if (SLICE (q) != NO_MOID && a68_is_strong_slice (p, q))
+    return true;
+  else if (IS_FLEX (q) && a68_is_strong_slice (p, q))
+    return true;
+  else if (a68_is_widenable (p, q))
+    return true;
+  else if (a68_is_deprefable (p))
+    return a68_is_strongly_coercible (a68_depref_once (p), q, deflex);
+  else if (q == M_SIMPLOUT || q == M_ROW_SIMPLOUT)
+    return a68_is_printable_mode (p);
+  else
+    return false;
+}
+
+/* Basic coercions.  */
+
+bool
+a68_basic_coercions (MOID_T *p, MOID_T *q, int c, int deflex)
+{
+  if (a68_is_equal_modes (p, q, deflex))
+    return true;
+  else if (c == NO_SORT)
+    return (p == q);
+  else if (c == SOFT)
+    return a68_is_softly_coercible (p, q, deflex);
+  else if (c == WEAK)
+    return a68_is_weakly_coercible (p, q, deflex);
+  else if (c == MEEK)
+    return a68_is_meekly_coercible (p, q, deflex);
+  else if (c == FIRM)
+    return a68_is_firmly_coercible (p, q, deflex);
+  else if (c == STRONG)
+    return a68_is_strongly_coercible (p, q, deflex);
+  else
+    return false;
+}
+
+/* Whether coercible stowed.  */
+
+bool
+a68_is_coercible_stowed (MOID_T *p, MOID_T *q, int c, int deflex)
+{
+  if (c != STRONG)
+    /* Such construct is always in a strong position, is it not?  */
+    return false;
+  else if (q == M_VOID)
+    return true;
+  else if (IS_FLEX (q))
+    {
+      bool j = true;
+
+      for (PACK_T *u = PACK (p); u != NO_PACK && j; FORWARD (u))
+	j &= a68_is_coercible (MOID (u), SLICE (SUB (q)), c, deflex);
+      return j;
+    }
+  else if (IS_ROW (q))
+    {
+      bool j = true;
+
+      for (PACK_T *u = PACK (p); u != NO_PACK && j; FORWARD (u))
+	j &= a68_is_coercible (MOID (u), SLICE (q), c, deflex);
+      return j;
+    }
+  else if (IS (q, PROC_SYMBOL) || IS (q, STRUCT_SYMBOL))
+    {
+      if (DIM (p) != DIM (q))
+	return false;
+      else
+	{
+	  PACK_T *u = PACK (p), *v = PACK (q);
+	  bool j = true;
+
+	  while (u != NO_PACK && v != NO_PACK && j)
+	    {
+	      j &= a68_is_coercible (MOID (u), MOID (v), c, deflex);
+	      FORWARD (u);
+	      FORWARD (v);
+	    }
+	  return j;
+	}
+    }
+  else
+    return false;
+}
+
+/* Whether coercible series.  */
+
+bool
+a68_is_coercible_series (MOID_T *p, MOID_T *q, int c, int deflex)
+{
+  if (c == NO_SORT)
+    return false;
+  else if (p == NO_MOID || q == NO_MOID)
+    return false;
+  else if (IS (p, SERIES_MODE) && PACK (p) == NO_PACK)
+    return false;
+  else if (IS (q, SERIES_MODE) && PACK (q) == NO_PACK)
+    return false;
+  else if (PACK (p) == NO_PACK)
+    return a68_is_coercible (p, q, c, deflex);
+  else
+    {
+      bool j = true;
+
+      for (PACK_T *u = PACK (p); u != NO_PACK && j; FORWARD (u))
+	{
+	  if (MOID (u) != NO_MOID)
+	    j &= a68_is_coercible (MOID (u), q, c, deflex);
+	}
+    return j;
+    }
+}
+
+/* Whether P can be coerced to Q in a C context.  */
+
+bool
+a68_is_coercible (MOID_T *p, MOID_T *q, int c, int deflex)
+{
+  if (a68_is_mode_isnt_well (p) || a68_is_mode_isnt_well (q))
+    return true;
+  else if (a68_is_equal_modes (p, q, deflex))
+    return true;
+  else if (p == M_HIP)
+    return true;
+  else if (IS (p, STOWED_MODE))
+    return a68_is_coercible_stowed (p, q, c, deflex);
+  else if (IS (p, SERIES_MODE))
+    return a68_is_coercible_series (p, q, c, deflex);
+  else if (p == M_VACUUM && IS_ROW (DEFLEX (q)))
+    return true;
+  else
+    return a68_basic_coercions (p, q, c, deflex);
+}
+
+/* Whether coercible in context.  */
+
+bool
+a68_is_coercible_in_context (SOID_T *p, SOID_T *q, int deflex)
+{
+  if (SORT (p) != SORT (q))
+    return false;
+  else if (MOID (p) == MOID (q))
+    return true;
+  else
+    return a68_is_coercible (MOID (p), MOID (q), SORT (q), deflex);
+}
+
+/* Whether list Y is balanced.  */
+
+bool
+a68_is_balanced (NODE_T *n, SOID_T *y, int sort)
+{
+  if (sort == STRONG)
+    return true;
+  else
+    {
+      bool k = false;
+
+      for (; y != NO_SOID && !k; FORWARD (y)) 
+	k = (!IS (MOID (y), STOWED_MODE));
+
+      if (k == false)
+	a68_error (n, "construct has no unique mode");
+      return k;
+    }
+}
+
+/* A moid from M to which all other members can be coerced.
+   If no fulcrum of the balance is found, return NO_MOID.  */
+
+MOID_T *
+a68_get_balanced_mode_or_no_mode (MOID_T *m, int sort, bool return_depreffed, int deflex)
+{
+  MOID_T *common_moid = NO_MOID;
+
+  if (m != NO_MOID && !a68_is_mode_isnt_well (m) && IS (m, UNION_SYMBOL))
+    {
+      int depref_level;
+      bool siga = true;
+      /* Test for increasing depreffing.  */
+      for (depref_level = 0; siga; depref_level++)
+	{
+	  siga = false;
+	  /* Test the whole pack.  */
+	  for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p))
+	    {
+	      /* HIPs are not eligible of course.  */
+	      if (MOID (p) != M_HIP)
+		{
+		  MOID_T *candidate = MOID (p);
+		  int k;
+		  /* Depref as far as allowed.  */
+		  for (k = depref_level; k > 0 && a68_is_deprefable (candidate); k--)
+		    candidate = a68_depref_once (candidate);
+		  /* Only need testing if all allowed deprefs succeeded.  */
+		  if (k == 0)
+		    {
+		      MOID_T *to = (return_depreffed ? a68_depref_completely (candidate) : candidate);
+		      bool all_coercible = true;
+
+		      siga = true;
+		      for (PACK_T *q = PACK (m); q != NO_PACK && all_coercible; FORWARD (q))
+			{
+			  MOID_T *from = MOID (q);
+			  if (p != q && from != to)
+			    all_coercible &= a68_is_coercible (from, to, sort, deflex);
+			}
+		      /* If the pack is coercible to the candidate, we mark the
+			 candidate.  We continue searching for longest series
+			 of REF REF PROC REF.  */
+		      if (all_coercible)
+			{
+			  MOID_T *mark = (return_depreffed ? MOID (p) : candidate);
+
+			  if (common_moid == NO_MOID)
+			    common_moid = mark;
+			  else if (IS_FLEX (candidate) && DEFLEX (candidate) == common_moid)
+			    /* We prefer FLEX.  */
+			    common_moid = mark;
+			}
+		    }
+		}
+	    }
+	}
+    }
+
+  return common_moid;
+}
+
+/* A moid from M to which all other members can be coerced.
+   If no fulcrum of the balance is found, return M.  */
+
+MOID_T *
+a68_get_balanced_mode (MOID_T *m, int sort, bool return_depreffed, int deflex)
+{
+  MOID_T *common_moid
+    = a68_get_balanced_mode_or_no_mode (m, sort, return_depreffed, deflex);
+  return common_moid == NO_MOID ? m : common_moid;
+}
+
+/* Whether we can search a common mode from a clause or not.  */
+
+bool
+a68_clause_allows_balancing (int att)
+{
+  switch (att)
+    {
+    case CLOSED_CLAUSE:
+    case CONDITIONAL_CLAUSE:
+    case CASE_CLAUSE:
+    case SERIAL_CLAUSE:
+    case CONFORMITY_CLAUSE:
+      return true;
+    }
+  return false;
+}
+
+/* A unique mode from Z.  */
+
+MOID_T *
+a68_determine_unique_mode (SOID_T *z, int deflex)
+{
+  if (z == NO_SOID)
+    return NO_MOID;
+  else
+    {
+      MOID_T *x = MOID (z);
+
+      if (a68_is_mode_isnt_well (x))
+	return M_ERROR;
+
+      x = a68_make_united_mode (x);
+      if (a68_clause_allows_balancing (ATTRIBUTE (z)))
+	return a68_get_balanced_mode (x, STRONG, A68_NO_DEPREF, deflex);
+      else
+	return x;
+    }
+}
+
+/* Insert coercion A in the tree.  */
+
+void
+a68_make_coercion (NODE_T *l, enum a68_attribute a, MOID_T *m)
+{
+  a68_make_sub (l, l, a);
+  MOID (l) = a68_depref_rows (MOID (l), m);
+}
+
+/* Make widening coercion.  */
+
+static void
+make_widening_coercion (NODE_T *n, MOID_T *p, MOID_T *q)
+{
+  MOID_T *z = a68_widens_to (p, q);
+
+  a68_make_coercion (n, WIDENING, z);
+  if (z != q)
+    make_widening_coercion (n, z, q);
+}
+
+/* Make ref rowing coercion.  */
+
+void
+a68_make_ref_rowing_coercion (NODE_T *n, MOID_T *p, MOID_T *q)
+{
+  if (DEFLEX (p) != DEFLEX (q))
+    {
+      if (a68_is_widenable (p, q))
+	make_widening_coercion (n, p, q);
+      else if (a68_is_ref_row (q))
+	{
+	  a68_make_ref_rowing_coercion (n, p, NAME (q));
+	  a68_make_coercion (n, ROWING, q);
+	}
+    }
+}
+
+/* Make rowing coercion.  */
+
+void
+a68_make_rowing_coercion (NODE_T *n, MOID_T *p, MOID_T *q)
+{
+  if (DEFLEX (p) != DEFLEX (q))
+    {
+      if (a68_is_widenable (p, q))
+	make_widening_coercion (n, p, q);
+      else if (SLICE (q) != NO_MOID)
+	{
+	  a68_make_rowing_coercion (n, p, SLICE (q));
+	  a68_make_coercion (n, ROWING, q);
+	}
+      else if (IS_FLEX (q))
+	a68_make_rowing_coercion (n, p, SUB (q));
+      else if (a68_is_ref_row (q))
+	a68_make_ref_rowing_coercion (n, p, q);
+    }
+}
+
+/* Make uniting coercion.  */
+
+void
+a68_make_uniting_coercion (NODE_T *n, MOID_T *q)
+{
+  a68_make_coercion (n, UNITING, a68_derow (q));
+  if (IS_ROW (q) || IS_FLEX (q))
+    a68_make_rowing_coercion (n, a68_derow (q), q);
+}
+
+/* Make depreffing coercion to coerce node N from mode P to mode Q in a strong
+   context.  */
+
+void
+a68_make_depreffing_coercion (NODE_T *n, MOID_T *p, MOID_T *q)
+{
+  if (DEFLEX (p) == DEFLEX (q))
+    return;
+  else if (q == M_SIMPLOUT && a68_is_printable_mode (p))
+    a68_make_coercion (n, UNITING, q);
+  else if (q == M_ROW_SIMPLOUT && a68_is_printable_mode (p))
+    {
+      a68_make_coercion (n, UNITING, M_SIMPLOUT);
+      a68_make_coercion (n, ROWING, M_ROW_SIMPLOUT);
+    }
+  else if (q == M_SIMPLIN && a68_is_readable_mode (p))
+    a68_make_coercion (n, UNITING, q);
+  else if (q == M_ROW_SIMPLIN && a68_is_readable_mode (p))
+    {
+      a68_make_coercion (n, UNITING, M_SIMPLIN);
+      a68_make_coercion (n, ROWING, M_ROW_SIMPLIN);
+    }
+  else if (q == M_ROWS && a68_is_rows_type (p))
+    {
+      a68_make_coercion (n, UNITING, M_ROWS);
+      MOID (n) = M_ROWS;
+    }
+  else if (a68_is_widenable (p, q))
+    make_widening_coercion (n, p, q);
+  else if (a68_is_unitable (p, a68_derow (q), SAFE_DEFLEXING))
+    a68_make_uniting_coercion (n, q);
+  else if (a68_is_ref_row (q) && a68_is_strong_name (p, q))
+    a68_make_ref_rowing_coercion (n, p, q);
+  else if (SLICE (q) != NO_MOID && a68_is_strong_slice (p, q))
+    a68_make_rowing_coercion (n, p, q);
+  else if (IS_FLEX (q) && a68_is_strong_slice (p, q))
+    a68_make_rowing_coercion (n, p, q);
+  else if (IS_REF (p))
+    {
+      MOID_T *r = a68_depref_once (p);
+      a68_make_coercion (n, DEREFERENCING, r);
+      a68_make_depreffing_coercion (n, r, q);
+    }
+  else if (IS (p, PROC_SYMBOL) && PACK (p) == NO_PACK)
+    {
+      MOID_T *r = SUB (p);
+
+      a68_make_coercion (n, DEPROCEDURING, r);
+      a68_make_depreffing_coercion (n, r, q);
+    }
+  else if (p != q)
+    a68_cannot_coerce (n, p, q, NO_SORT, SKIP_DEFLEXING, 0);
+}
+
+/* Whether p is a nonproc mode (that is voided directly).  */
+
+bool
+a68_is_nonproc (MOID_T *p)
+{
+  if (IS (p, PROC_SYMBOL) && PACK (p) == NO_PACK)
+    return false;
+  else if (IS_REF (p))
+    return a68_is_nonproc (SUB (p));
+  else
+    return true;
+}
+
+/* Voiden in an appropriate way.  */
+
+void
+a68_make_void (NODE_T *p, MOID_T *q)
+{
+  switch (ATTRIBUTE (p))
+    {
+    case ASSIGNATION:
+    case IDENTITY_RELATION:
+    case GENERATOR:
+    case CAST:
+    case DENOTATION:
+      a68_make_coercion (p, VOIDING, M_VOID);
+      return;
+    default:
+      break;
+    }
+
+  /* MORFs are an involved case.  */
+  switch (ATTRIBUTE (p))
+    {
+    case SELECTION:
+    case SLICE:
+    case ROUTINE_TEXT:
+    case FORMULA:
+    case CALL:
+    case IDENTIFIER:
+      /* A nonproc moid value is eliminated directly.  */
+      if (a68_is_nonproc (q))
+	{
+	  a68_make_coercion (p, VOIDING, M_VOID);
+	  return;
+	}
+      else
+	{
+	  /* Descend the chain of e.g. REF PROC .. until a nonproc moid
+	     remains.  */
+	  MOID_T *z = q;
+
+	  while (!a68_is_nonproc (z))
+	    {
+	      if (IS_REF (z))
+		a68_make_coercion (p, DEREFERENCING, SUB (z));
+	      if (IS (z, PROC_SYMBOL) && NODE_PACK (p) == NO_PACK)
+		a68_make_coercion (p, DEPROCEDURING, SUB (z));
+	      z = SUB (z);
+	    }
+	  if (z != M_VOID)
+	    a68_make_coercion (p, VOIDING, M_VOID);
+	  return;
+	}
+    default:
+      break;
+    }
+
+  /* All other is voided straight away.  */
+  a68_make_coercion (p, VOIDING, M_VOID);
+}
+
+/* Make strong coercion of node N from mode P to mode Q.  */
+
+void
+a68_make_strong (NODE_T *n, MOID_T *p, MOID_T *q)
+{
+  if (q == M_VOID && p != M_VOID)
+    a68_make_void (n, p);
+  else
+    a68_make_depreffing_coercion (n, p, q);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-moids-to-string.cc
@@ -0,0 +1,366 @@
+/* Pretty-print a MOID.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "a68.h"
+
+/*
+ * A pretty printer for moids.
+ *
+ * For example "PROC (REF STRUCT (REF SELF, UNION (INT, VOID))) REF SELF"
+ * for a procedure yielding a pointer to an object of its own mode.
+ */
+
+static void moid_to_string_2 (char *, MOID_T *, size_t *, NODE_T *,
+			      bool indicant_value);
+
+/* Add string to MOID text.  */
+
+static void
+add_to_moid_text (char *dst, const char *str, size_t *w)
+{
+  a68_bufcat (dst, str, BUFFER_SIZE);
+  (*w) -= strlen (str);
+}
+
+/* Find a tag, searching symbol tables towards the root.  */
+
+static TAG_T *
+find_indicant_global (TABLE_T * table, MOID_T * mode)
+{
+  if (table != NO_TABLE)
+    {
+      for (TAG_T *s = INDICANTS (table); s != NO_TAG; FORWARD (s))
+	{
+	  if (MOID (s) == mode)
+	    return s;
+	}
+      return find_indicant_global (PREVIOUS (table), mode);
+    }
+  else
+    return NO_TAG;
+}
+
+/* Pack to string.  */
+
+static void
+pack_to_string (char *b, PACK_T *p, size_t *w, bool text, NODE_T *idf,
+		bool indicant_value)
+{
+  for (; p != NO_PACK; FORWARD (p))
+    {
+      moid_to_string_2 (b, MOID (p), w, idf, indicant_value);
+      if (text)
+	{
+	  if (TEXT (p) != NO_TEXT)
+	    {
+	      add_to_moid_text (b, " ", w);
+	      add_to_moid_text (b, TEXT (p), w);
+	    }
+	}
+      if (p != NO_PACK && NEXT (p) != NO_PACK)
+	add_to_moid_text (b, ", ", w);
+    }
+}
+
+/* Moid to string 2.  */
+
+static void moid_to_string_2 (char *b, MOID_T *n, size_t *w, NODE_T *idf,
+			      bool indicant_value)
+{
+  if (n == NO_MOID)
+    {
+      /* Oops. Should not happen.  */
+      add_to_moid_text (b, "null", w);;
+      return;
+    }
+
+  /* Reference to self through REF or PROC.  */
+  if (a68_is_postulated (A68 (postulates), n))
+    {
+      add_to_moid_text (b, "SELF", w);
+      return;
+    }
+
+  /* If declared by a mode-declaration, present the indicant.  */
+  if (idf != NO_NODE && !IS (n, STANDARD))
+    {
+      TAG_T *indy = find_indicant_global (TABLE (idf), n);
+
+      if (indy != NO_TAG)
+	{
+	  add_to_moid_text (b, NSYMBOL (NODE (indy)), w);
+	  if (!indicant_value)
+	    return;
+	  else
+	    add_to_moid_text (b, " = ", w);
+	}
+    }
+
+  /* Write the standard modes.  */
+  if (n == M_HIP)
+    add_to_moid_text (b, "HIP", w);
+  else if (n == M_ERROR)
+    add_to_moid_text (b, "ERROR", w);
+  else if (n == M_UNDEFINED)
+    add_to_moid_text (b, "unresolved mode", w);
+  else if (n == M_C_STRING)
+    add_to_moid_text (b, "C-STRING", w);
+  else if (n == M_COMPLEX)
+    add_to_moid_text (b, "COMPL", w);
+  else if (n == M_LONG_COMPLEX)
+    add_to_moid_text (b, "LONG COMPL", w);
+  else if (n == M_LONG_LONG_COMPLEX)
+    add_to_moid_text (b, "LONG LONG COMPL", w);
+  else if (n == M_STRING)
+    add_to_moid_text (b, "STRING", w);
+  else if (n == M_COLLITEM)
+    add_to_moid_text (b, "COLLITEM", w);
+  else if (IS (n, IN_TYPE_MODE))
+    add_to_moid_text (b, "\"SIMPLIN\"", w);
+  else if (IS (n, OUT_TYPE_MODE))
+    add_to_moid_text (b, "\"SIMPLOUT\"", w);
+  else if (IS (n, ROWS_SYMBOL))
+    add_to_moid_text (b, "\"ROWS\"", w);
+  else if (n == M_VACUUM)
+    add_to_moid_text (b, "\"VACUUM\"", w);
+  else if (IS (n, VOID_SYMBOL) || IS (n, STANDARD) || IS (n, INDICANT))
+    {
+      if (DIM (n) > 0)
+	{
+	  size_t k = DIM (n);
+
+	  if ((*w) >= k * strlen ("LONG ") + strlen (NSYMBOL (NODE (n))))
+	    {
+	      while (k--)
+		add_to_moid_text (b, "LONG ", w);
+	      add_to_moid_text (b, NSYMBOL (NODE (n)), w);
+	    }
+	  else
+	    add_to_moid_text (b, "..", w);
+	}
+      else if (DIM (n) < 0)
+	{
+	  size_t k = -DIM (n);
+
+	  if ((*w) >= k * strlen ("SHORT ") + strlen (NSYMBOL (NODE (n))))
+	    {
+	      while (k--)
+		add_to_moid_text (b, "SHORT ", w);
+	      add_to_moid_text (b, NSYMBOL (NODE (n)), w);
+	    }
+	  else
+	    add_to_moid_text (b, "..", w);
+	}
+      else if (DIM (n) == 0)
+	add_to_moid_text (b, NSYMBOL (NODE (n)), w);
+
+      /*  Write compxounded modes.  */
+    }
+  else if (IS_REF (n))
+    {
+      if ((*w) >= strlen ("REF .."))
+	{
+	  add_to_moid_text (b, "REF ", w);
+	  moid_to_string_2 (b, SUB (n), w, idf, indicant_value);
+	}
+      else
+	  add_to_moid_text (b, "REF ..", w);
+    }
+  else if (IS_FLEX (n))
+    {
+      if ((*w) >= strlen ("FLEX .."))
+	{
+	  add_to_moid_text (b, "FLEX ", w);
+	  moid_to_string_2 (b, SUB (n), w, idf, indicant_value);
+	}
+      else
+	add_to_moid_text (b, "FLEX ..", w);
+    }
+  else if (IS_ROW (n))
+    {
+      size_t j = strlen ("[] ..") + (DIM (n) - 1) * strlen (",");
+
+      if ((*w) >= j)
+	{
+	  size_t k = DIM (n) - 1;
+	  add_to_moid_text (b, "[", w);
+	  while (k-- > 0)
+	    add_to_moid_text (b, ",", w);
+	  add_to_moid_text (b, "] ", w);
+	  moid_to_string_2 (b, SUB (n), w, idf, indicant_value);
+	}
+      else if (DIM (n) == 1)
+	{
+	  add_to_moid_text (b, "[] ..", w);
+	}
+      else
+	{
+	  size_t k = DIM (n);
+	  add_to_moid_text (b, "[", w);
+	  while (k--)
+	    add_to_moid_text (b, ",", w);
+	  add_to_moid_text (b, "] ..", w);
+	}
+    }
+  else if (IS_STRUCT (n))
+    {
+      size_t j = (strlen ("STRUCT ()") + (DIM (n) - 1)
+		  * strlen (".., ") + strlen (".."));
+
+      if ((*w) >= j)
+	{
+	  POSTULATE_T *save = A68 (postulates);
+	  a68_make_postulate (&A68 (postulates), n, NO_MOID);
+	  add_to_moid_text (b, "STRUCT (", w);
+	  pack_to_string (b, PACK (n), w, true, idf, indicant_value);
+	  add_to_moid_text (b, ")", w);
+	  a68_free_postulate_list (A68 (postulates), save);
+	  A68 (postulates) = save;
+	}
+      else
+	{
+	  size_t k = DIM (n);
+	  add_to_moid_text (b, "STRUCT (", w);
+	  while (k-- > 0)
+	    add_to_moid_text (b, ",", w);
+	  add_to_moid_text (b, ")", w);
+	}
+    }
+  else if (IS_UNION (n))
+    {
+      size_t j = (strlen ("UNION ()") + (DIM (n) - 1)
+		  * strlen (".., ") + strlen (".."));
+
+      if ((*w) >= j)
+	{
+	  POSTULATE_T *save = A68 (postulates);
+	  a68_make_postulate (&A68 (postulates), n, NO_MOID);
+	  add_to_moid_text (b, "UNION (", w);
+	  pack_to_string (b, PACK (n), w, false, idf, indicant_value);
+	  add_to_moid_text (b, ")", w);
+	  a68_free_postulate_list (A68 (postulates), save);
+	  A68 (postulates) = save;
+	}
+    else
+      {
+	size_t k = DIM (n);
+	add_to_moid_text (b, "UNION (", w);
+	while (k-- > 0)
+	  add_to_moid_text (b, ",", w);
+	add_to_moid_text (b, ")", w);
+      }
+    }
+  else if (IS (n, PROC_SYMBOL) && DIM (n) == 0)
+    {
+      if ((*w) >= strlen ("PROC .."))
+	{
+	  add_to_moid_text (b, "PROC ", w);
+	  moid_to_string_2 (b, SUB (n), w, idf, indicant_value);
+	}
+      else
+	add_to_moid_text (b, "PROC ..", w);
+    }
+  else if (IS (n, PROC_SYMBOL) && DIM (n) > 0)
+    {
+      size_t j = (strlen ("PROC () ..") + (DIM (n) - 1)
+		  * strlen (".., ") + strlen (".."));
+
+      if ((*w) >= j)
+	{
+	  POSTULATE_T *save = A68 (postulates);
+	  a68_make_postulate (&A68 (postulates), n, NO_MOID);
+	  add_to_moid_text (b, "PROC (", w);
+	  pack_to_string (b, PACK (n), w, false, idf, indicant_value);
+	  add_to_moid_text (b, ") ", w);
+	  moid_to_string_2 (b, SUB (n), w, idf, indicant_value);
+	  a68_free_postulate_list (A68 (postulates), save);
+	  A68 (postulates) = save;
+	}
+      else
+	{
+	  size_t k = DIM (n);
+
+	  add_to_moid_text (b, "PROC (", w);
+	  while (k-- > 0)
+	    add_to_moid_text (b, ",", w);
+	  add_to_moid_text (b, ") ..", w);
+	}
+    }
+  else if (IS (n, SERIES_MODE) || IS (n, STOWED_MODE))
+    {
+      size_t j = (strlen ("()") + (DIM (n) - 1)
+		  * strlen (".., ") + strlen (".."));
+
+      if ((*w) >= j)
+	{
+	  add_to_moid_text (b, "(", w);
+	  pack_to_string (b, PACK (n), w, false, idf, indicant_value);
+	  add_to_moid_text (b, ")", w);
+	}
+      else
+	{
+	  size_t k = DIM (n);
+
+	  add_to_moid_text (b, "(", w);
+	  while (k-- > 0)
+	    add_to_moid_text (b, ",", w);
+	  add_to_moid_text (b, ")", w);
+	}
+    }
+  else
+    {
+      char str[SMALL_BUFFER_SIZE];
+      if (snprintf (str, (size_t) SMALL_BUFFER_SIZE, "\\%d", ATTRIBUTE (n)) < 0)
+	gcc_unreachable ();
+      add_to_moid_text (b, str, w);
+    }
+}
+
+/* Pretty-formatted mode N; W is a measure of width.  */
+
+char *
+a68_moid_to_string (MOID_T *n, size_t w, NODE_T *idf, bool indicant_value)
+{
+#define MAX_MTS 8
+  /* We use a static buffer of MAX_MTS strings. This value 8 should be safe.
+     No more than MAX_MTS calls can be pending in for instance printf.  Instead
+     we could allocate each string on the heap but that leaks memory.  */
+  static int mts_buff_ptr = 0;
+  static char mts_buff[8][BUFFER_SIZE];
+  char *a = &(mts_buff[mts_buff_ptr][0]);
+  mts_buff_ptr++;
+  if (mts_buff_ptr >= MAX_MTS)
+    mts_buff_ptr = 0;
+  a[0] = '\0';
+  if (w >= BUFFER_SIZE)
+    w = BUFFER_SIZE - 1;
+  A68 (postulates) = NO_POSTULATE;
+  if (n != NO_MOID)
+    moid_to_string_2 (a, n, &w, idf, indicant_value);
+  else
+    a68_bufcat (a, "null", BUFFER_SIZE);
+  return a;
+#undef MAX_MTS
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-attrs.def
@@ -0,0 +1,362 @@
+/* This file contains the definitions and documentation for all the different
+   kind/attributes of Algol 68 parse tree nodes.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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/>.  */
+
+/* Please keep the entries in this file sorted alphabetically.  */
+
+A68_ATTR(A68_PATTERN)
+A68_ATTR(ACTUAL_DECLARER_MARK)
+A68_ATTR(ALT_DO_PART)
+A68_ATTR(ALT_DO_SYMBOL)
+A68_ATTR(ALT_EQUALS_SYMBOL)
+A68_ATTR(ALT_FORMAL_BOUNDS_LIST)
+A68_ATTR(ANDF_SYMBOL)
+A68_ATTR(AND_FUNCTION)
+A68_ATTR(ANONYMOUS)
+A68_ATTR(ARGUMENT)
+A68_ATTR(ARGUMENT_LIST)
+A68_ATTR(ASSERTION)
+A68_ATTR(ASSERT_SYMBOL)
+A68_ATTR(ASSIGNATION)
+A68_ATTR(ASSIGN_SYMBOL)
+A68_ATTR(ASSIGN_TO_SYMBOL)
+A68_ATTR(AT_SYMBOL)
+A68_ATTR(BEGIN_SYMBOL)
+A68_ATTR(BITS_C_PATTERN)
+A68_ATTR(BITS_DENOTATION)
+A68_ATTR(BITS_PATTERN)
+A68_ATTR(BITS_SYMBOL)
+A68_ATTR(BOLD_COMMENT_SYMBOL)
+A68_ATTR(BOLD_COMMENT_BEGIN_SYMBOL)
+A68_ATTR(BOLD_COMMENT_END_SYMBOL)
+A68_ATTR(BOLD_PRAGMAT_SYMBOL)
+A68_ATTR(BOLD_TAG)
+A68_ATTR(BOOLEAN_PATTERN)
+A68_ATTR(BOOL_SYMBOL)
+A68_ATTR(BOUND)
+A68_ATTR(BOUNDS)
+A68_ATTR(BOUNDS_LIST)
+A68_ATTR(BRIEF_COMMENT_BEGIN_SYMBOL)
+A68_ATTR(BRIEF_COMMENT_END_SYMBOL)
+A68_ATTR(BRIEF_OUSE_PART)
+A68_ATTR(BRIEF_CONFORMITY_OUSE_PART)
+A68_ATTR(BRIEF_ELIF_PART)
+A68_ATTR(BRIEF_OPERATOR_DECLARATION)
+A68_ATTR(BUS_SYMBOL)
+A68_ATTR(BYTES_SYMBOL)
+A68_ATTR(BY_PART)
+A68_ATTR(BY_SYMBOL)
+A68_ATTR(CALL)
+A68_ATTR(CASE_CHOICE_CLAUSE)
+A68_ATTR(CASE_CLAUSE)
+A68_ATTR(CASE_IN_PART)
+A68_ATTR(CASE_OUSE_PART)
+A68_ATTR(CASE_PART)
+A68_ATTR(CASE_SYMBOL)
+A68_ATTR(CAST)
+A68_ATTR(CHANNEL_SYMBOL)
+A68_ATTR(CHAR_C_PATTERN)
+A68_ATTR(CHAR_SYMBOL)
+A68_ATTR(CHOICE)
+A68_ATTR(CHOICE_PATTERN)
+A68_ATTR(CLOSED_CLAUSE)
+A68_ATTR(CLOSE_SYMBOL)
+A68_ATTR(COLLATERAL_CLAUSE)
+A68_ATTR(COLLECTION)
+A68_ATTR(COLON_SYMBOL)
+A68_ATTR(COMMA_SYMBOL)
+A68_ATTR(COMPLEX_PATTERN)
+A68_ATTR(COMPLEX_SYMBOL)
+A68_ATTR(COMPL_SYMBOL)
+A68_ATTR(CONDITIONAL_CLAUSE)
+A68_ATTR(CONFORMITY_CHOICE)
+A68_ATTR(CONFORMITY_CLAUSE)
+A68_ATTR(CONFORMITY_IN_PART)
+A68_ATTR(CONFORMITY_OUSE_PART)
+A68_ATTR(CONSTRUCT)
+A68_ATTR(DECLARATION_LIST)
+A68_ATTR(DECLARER)
+A68_ATTR(DEFINING_IDENTIFIER)
+A68_ATTR(DEFINING_INDICANT)
+A68_ATTR(DEFINING_OPERATOR)
+A68_ATTR(DENOTATION)
+A68_ATTR(DEPROCEDURING)
+A68_ATTR(DEREFERENCING)
+A68_ATTR(DO_PART)
+A68_ATTR(DO_SYMBOL)
+A68_ATTR(DYNAMIC_REPLICATOR)
+A68_ATTR(ELIF_IF_PART)
+A68_ATTR(ELIF_PART)
+A68_ATTR(ELIF_SYMBOL)
+A68_ATTR(ELSE_BAR_SYMBOL)
+A68_ATTR(ELSE_OPEN_PART)
+A68_ATTR(ELSE_PART)
+A68_ATTR(ELSE_SYMBOL)
+A68_ATTR(EMPTY_SYMBOL)
+A68_ATTR(ENCLOSED_CLAUSE)
+A68_ATTR(END_SYMBOL)
+A68_ATTR(ENQUIRY_CLAUSE)
+A68_ATTR(EQUALS_SYMBOL)
+A68_ATTR(ERROR)
+A68_ATTR(ERROR_IDENTIFIER)
+A68_ATTR(ESAC_SYMBOL)
+A68_ATTR(EXIT_SYMBOL)
+A68_ATTR(EXPONENT_FRAME)
+A68_ATTR(FALSE_SYMBOL)
+A68_ATTR(FIELD)
+A68_ATTR(FIELD_IDENTIFIER)
+A68_ATTR(FILE_SYMBOL)
+A68_ATTR(FIRM)
+A68_ATTR(FIXED_C_PATTERN)
+A68_ATTR(FI_SYMBOL)
+A68_ATTR(FLEX_SYMBOL)
+A68_ATTR(FLOAT_C_PATTERN)
+A68_ATTR(FORMAL_BOUNDS)
+A68_ATTR(FORMAL_BOUNDS_LIST)
+A68_ATTR(FORMAL_DECLARERS)
+A68_ATTR(FORMAL_DECLARERS_LIST)
+A68_ATTR(FORMAL_DECLARER_MARK)
+A68_ATTR(FORMULA)
+A68_ATTR(FOR_PART)
+A68_ATTR(FOR_SYMBOL)
+A68_ATTR(FORMAT_CLOSE_SYMBOL)
+A68_ATTR(FORMAT_DELIMITER_SYMBOL)
+A68_ATTR(FORMAT_IDENTIFIER)
+A68_ATTR(FORMAT_A_FRAME)
+A68_ATTR(FORMAT_D_FRAME)
+A68_ATTR(FORMAT_E_FRAME)
+A68_ATTR(FORMAT_I_FRAME)
+A68_ATTR(FORMAT_ITEM_A)
+A68_ATTR(FORMAT_ITEM_B)
+A68_ATTR(FORMAT_ITEM_C)
+A68_ATTR(FORMAT_ITEM_D)
+A68_ATTR(FORMAT_ITEM_E)
+A68_ATTR(FORMAT_ITEM_F)
+A68_ATTR(FORMAT_ITEM_G)
+A68_ATTR(FORMAT_ITEM_H)
+A68_ATTR(FORMAT_ITEM_I)
+A68_ATTR(FORMAT_ITEM_J)
+A68_ATTR(FORMAT_ITEM_K)
+A68_ATTR(FORMAT_ITEM_L)
+A68_ATTR(FORMAT_ITEM_M)
+A68_ATTR(FORMAT_ITEM_N)
+A68_ATTR(FORMAT_ITEM_O)
+A68_ATTR(FORMAT_ITEM_P)
+A68_ATTR(FORMAT_ITEM_Q)
+A68_ATTR(FORMAT_ITEM_R)
+A68_ATTR(FORMAT_ITEM_S)
+A68_ATTR(FORMAT_ITEM_T)
+A68_ATTR(FORMAT_ITEM_U)
+A68_ATTR(FORMAT_ITEM_V)
+A68_ATTR(FORMAT_ITEM_W)
+A68_ATTR(FORMAT_ITEM_X)
+A68_ATTR(FORMAT_ITEM_Y)
+A68_ATTR(FORMAT_ITEM_Z)
+A68_ATTR(FORMAT_ITEM_ESCAPE)
+A68_ATTR(FORMAT_ITEM_MINUS)
+A68_ATTR(FORMAT_ITEM_PLUS)
+A68_ATTR(FORMAT_ITEM_POINT)
+A68_ATTR(FORMAT_OPEN_SYMBOL)
+A68_ATTR(FORMAT_PATTERN)
+A68_ATTR(FORMAT_POINT_FRAME)
+A68_ATTR(FORMAT_SYMBOL)
+A68_ATTR(FORMAT_TEXT)
+A68_ATTR(FORMAT_Z_FRAME)
+A68_ATTR(FROM_PART)
+A68_ATTR(FROM_SYMBOL)
+A68_ATTR(GENERAL_C_PATTERN)
+A68_ATTR(GENERAL_PATTERN)
+A68_ATTR(GENERATOR)
+A68_ATTR(GENERIC_ARGUMENT)
+A68_ATTR(GENERIC_ARGUMENT_LIST)
+A68_ATTR(GOTO_SYMBOL)
+A68_ATTR(GO_SYMBOL)
+A68_ATTR(GUARDED_CONDITIONAL_CLAUSE)
+A68_ATTR(GUARDED_LOOP_CLAUSE)
+A68_ATTR(HEAP_SYMBOL)
+A68_ATTR(IDENTIFIER)
+A68_ATTR(IDENTIFIER_WITH_UNDERSCORES)
+A68_ATTR(IDENTITY_DECLARATION)
+A68_ATTR(IDENTITY_RELATION)
+A68_ATTR(IF_PART)
+A68_ATTR(IF_SYMBOL)
+A68_ATTR(INDICANT)
+A68_ATTR(INITIALISER_SERIES)
+A68_ATTR(INSERTION)
+A68_ATTR(INTEGRAL_C_PATTERN)
+A68_ATTR(INTEGRAL_MOULD)
+A68_ATTR(INTEGRAL_PATTERN)
+A68_ATTR(INT_DENOTATION)
+A68_ATTR(INT_SYMBOL)
+A68_ATTR(IN_SYMBOL)
+A68_ATTR(IN_TYPE_MODE)
+A68_ATTR(ISNT_SYMBOL)
+A68_ATTR(IS_SYMBOL)
+A68_ATTR(JUMP)
+A68_ATTR(KEYWORD)
+A68_ATTR(LABEL)
+A68_ATTR(LABELED_UNIT)
+A68_ATTR(LABEL_IDENTIFIER)
+A68_ATTR(LABEL_SEQUENCE)
+A68_ATTR(LITERAL)
+A68_ATTR(LOCAL_LABEL)
+A68_ATTR(LOC_SYMBOL)
+A68_ATTR(LONGETY)
+A68_ATTR(LONG_SYMBOL)
+A68_ATTR(LOOP_CLAUSE)
+A68_ATTR(LOOP_IDENTIFIER)
+A68_ATTR(MAIN_SYMBOL)
+A68_ATTR(MEEK)
+A68_ATTR(MODE_BITS)
+A68_ATTR(MODE_BOOL)
+A68_ATTR(MODE_BYTES)
+A68_ATTR(MODE_CHAR)
+A68_ATTR(MODE_COMPLEX)
+A68_ATTR(MODE_DECLARATION)
+A68_ATTR(MODE_FILE)
+A68_ATTR(MODE_FORMAT)
+A68_ATTR(A68_MODE_INT)
+A68_ATTR(MODE_LONG_LONG_BITS)
+A68_ATTR(MODE_LONG_LONG_COMPLEX)
+A68_ATTR(MODE_LONG_LONG_INT)
+A68_ATTR(MODE_LONG_LONG_REAL)
+A68_ATTR(MODE_LONG_BITS)
+A68_ATTR(MODE_LONG_BYTES)
+A68_ATTR(MODE_LONG_COMPLEX)
+A68_ATTR(MODE_LONG_INT)
+A68_ATTR(MODE_LONG_REAL)
+A68_ATTR(MODE_NO_CHECK)
+A68_ATTR(MODE_REAL)
+A68_ATTR(MODE_SYMBOL)
+A68_ATTR(MONADIC_FORMULA)
+A68_ATTR(MONAD_SEQUENCE)
+A68_ATTR(NIHIL)
+A68_ATTR(NIL_SYMBOL)
+A68_ATTR(NORMAL_IDENTIFIER)
+A68_ATTR(NO_SORT)
+A68_ATTR(OD_SYMBOL)
+A68_ATTR(OF_SYMBOL)
+A68_ATTR(OPEN_PART)
+A68_ATTR(OPEN_SYMBOL)
+A68_ATTR(OPERATOR)
+A68_ATTR(OPERATOR_DECLARATION)
+A68_ATTR(OPERATOR_PLAN)
+A68_ATTR(OP_SYMBOL)
+A68_ATTR(ORF_SYMBOL)
+A68_ATTR(OR_FUNCTION)
+A68_ATTR(OUSE_PART)
+A68_ATTR(OUSE_SYMBOL)
+A68_ATTR(OUT_PART)
+A68_ATTR(OUT_SYMBOL)
+A68_ATTR(OUT_TYPE_MODE)
+A68_ATTR(PARALLEL_CLAUSE)
+A68_ATTR(PARAMETER)
+A68_ATTR(PARAMETER_IDENTIFIER)
+A68_ATTR(PARAMETER_LIST)
+A68_ATTR(PARAMETER_PACK)
+A68_ATTR(PARTICULAR_PROGRAM)
+A68_ATTR(PAR_SYMBOL)
+A68_ATTR(PICTURE)
+A68_ATTR(PICTURE_LIST)
+A68_ATTR(PIPE_SYMBOL)
+A68_ATTR(POINT_SYMBOL)
+A68_ATTR(PRIMARY)
+A68_ATTR(PRIORITY)
+A68_ATTR(PRIORITY_DECLARATION)
+A68_ATTR(PRIO_SYMBOL)
+A68_ATTR(PROCEDURE_DECLARATION)
+A68_ATTR(PROCEDURE_VARIABLE_DECLARATION)
+A68_ATTR(PROCEDURING)
+A68_ATTR(PROC_SYMBOL)
+A68_ATTR(QUALIFIER)
+A68_ATTR(RADIX_FRAME)
+A68_ATTR(REAL_DENOTATION)
+A68_ATTR(REAL_PATTERN)
+A68_ATTR(REAL_SYMBOL)
+A68_ATTR(REF_SYMBOL)
+A68_ATTR(REPLICATOR)
+A68_ATTR(ROUTINE_TEXT)
+A68_ATTR(ROUTINE_UNIT)
+A68_ATTR(ROWING)
+A68_ATTR(ROWS_SYMBOL)
+A68_ATTR(ROW_CHAR_DENOTATION)
+A68_ATTR(ROW_SYMBOL)
+A68_ATTR(SECONDARY)
+A68_ATTR(SELECTION)
+A68_ATTR(SELECTOR)
+A68_ATTR(SEMA_SYMBOL)
+A68_ATTR(SEMI_SYMBOL)
+A68_ATTR(SERIAL_CLAUSE)
+A68_ATTR(SERIES_MODE)
+A68_ATTR(SHORTETY)
+A68_ATTR(SHORT_SYMBOL)
+A68_ATTR(SIGN_MOULD)
+A68_ATTR(SKIP)
+A68_ATTR(SKIP_SYMBOL)
+A68_ATTR(SLICE)
+A68_ATTR(SOFT)
+A68_ATTR(SOME_CLAUSE)
+A68_ATTR(SPECIFICATION)
+A68_ATTR(SPECIFIED_UNIT)
+A68_ATTR(SPECIFIED_UNIT_LIST)
+A68_ATTR(SPECIFIED_UNIT_UNIT)
+A68_ATTR(SPECIFIER)
+A68_ATTR(SPECIFIER_IDENTIFIER)
+A68_ATTR(STANDARD)
+A68_ATTR(STATIC_REPLICATOR)
+A68_ATTR(STOWED_MODE)
+A68_ATTR(STRING_C_PATTERN)
+A68_ATTR(STRING_PATTERN)
+A68_ATTR(STRING_SYMBOL)
+A68_ATTR(STRONG)
+A68_ATTR(STRUCTURED_FIELD)
+A68_ATTR(STRUCTURED_FIELD_LIST)
+A68_ATTR(STRUCTURE_PACK)
+A68_ATTR(STRUCT_SYMBOL)
+A68_ATTR(STYLE_II_COMMENT_SYMBOL)
+A68_ATTR(STYLE_I_COMMENT_SYMBOL)
+A68_ATTR(STYLE_I_PRAGMAT_SYMBOL)
+A68_ATTR(SUB_SYMBOL)
+A68_ATTR(SUB_UNIT)
+A68_ATTR(TERTIARY)
+A68_ATTR(THEN_BAR_SYMBOL)
+A68_ATTR(THEN_PART)
+A68_ATTR(THEN_SYMBOL)
+A68_ATTR(TO_PART)
+A68_ATTR(TO_SYMBOL)
+A68_ATTR(TRIMMER)
+A68_ATTR(TRUE_SYMBOL)
+A68_ATTR(UNION_DECLARER_LIST)
+A68_ATTR(UNION_PACK)
+A68_ATTR(UNION_SYMBOL)
+A68_ATTR(UNIT)
+A68_ATTR(UNITING)
+A68_ATTR(UNIT_LIST)
+A68_ATTR(UNIT_SERIES)
+A68_ATTR(VARIABLE_DECLARATION)
+A68_ATTR(VIRTUAL_DECLARER_MARK)
+A68_ATTR(VOIDING)
+A68_ATTR(VOID_SYMBOL)
+A68_ATTR(WEAK)
+A68_ATTR(WHILE_PART)
+A68_ATTR(WHILE_SYMBOL)
+A68_ATTR(WIDENING)
+A68_ATTR(WILDCARD)
+
+/*
+Local variables:
+mode:c
+End:
+*/
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-bottom-up.cc
@@ -0,0 +1,2542 @@
+/* Hand-coded bottom-up parser for Algol 68.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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 code constitutes an effective "Algol 68 VW parser"; a pragmatic
+   approach was chosen since in the early days of Algol 68, many "ab initio"
+   implementations failed.
+
+   This is a Mailloux-type parser, in the sense that it scans a "phrase" for
+   definitions needed for parsing, and therefore allows for tags to be used
+   before they are defined, which gives some freedom in top-down programming.
+
+      B. J. Mailloux. On the implementation of Algol 68.
+      Thesis, Universiteit van Amsterdam (Mathematisch Centrum) [1968].
+
+   Technically, Mailloux's approach renders the two-level grammar LALR.  This
+   is the bottom-up parser that resolves the structure of the program.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "options.h"
+
+#include "a68.h"
+
+/* Bottom-up parser, reduces all constructs.  */
+
+
+/* Maximum number of errors the bottom-up parser will try to recover from and
+   save diagnostics for.  */
+
+#define MAX_ERRORS 5
+
+/* Forward declarations of some of the functions defined below.  */
+
+static void reduce_branch (NODE_T *q, a68_attribute expect);
+static void recover_from_error (NODE_T * p, enum a68_attribute expect, bool suppress);
+static void reduce_declarers (NODE_T *p, enum a68_attribute expect);
+static void reduce_primary_parts (NODE_T *p, enum a68_attribute expect);
+static void reduce_primaries (NODE_T *p, enum a68_attribute expect);
+static void reduce_format_texts (NODE_T *p);
+static void reduce_secondaries (NODE_T *p);
+static void reduce_formulae (NODE_T * p);
+static void reduce_tertiaries (NODE_T *p);
+static void reduce_right_to_left_constructs (NODE_T *p);
+static void reduce_units (NODE_T * p);
+static void reduce_erroneous_units (NODE_T *p);
+static void reduce_generic_arguments (NODE_T *p);
+static void reduce_bounds (NODE_T *p);
+static void reduce_serial_clauses (NODE_T *p);
+static void reduce_enquiry_clauses (NODE_T *p);
+static void reduce_collateral_clauses (NODE_T *p);
+static void reduce_arguments (NODE_T *p);
+static void reduce_enclosed_clauses (NODE_T *q, enum a68_attribute expect);
+static void reduce_basic_declarations (NODE_T *p);
+static void reduce_declaration_lists (NODE_T *p);
+static NODE_T *reduce_dyadic (NODE_T *p, int u);
+
+/* Whether a series is serial or collateral.  */
+
+static enum a68_attribute
+serial_or_collateral (NODE_T *p)
+{
+  int semis = 0, commas = 0, exits = 0;
+  for (NODE_T *q = p; q != NO_NODE; q = NEXT (q))
+    {
+      if (IS (q, COMMA_SYMBOL))
+	commas++;
+      else if (IS (q, SEMI_SYMBOL))
+	semis++;
+      else if (IS (q, EXIT_SYMBOL))
+	exits++;
+    }
+
+  if (semis == 0 && exits == 0 && commas > 0)
+    return COLLATERAL_CLAUSE;
+  else if ((semis > 0 || exits > 0) && commas == 0)
+    return SERIAL_CLAUSE;
+  else if (semis == 0 && exits == 0 && commas == 0)
+    return SERIAL_CLAUSE;
+  else
+    /* Heuristic guess to give intelligible error message.  */
+    return (semis + exits >= commas) ? SERIAL_CLAUSE : COLLATERAL_CLAUSE;
+}
+
+/* Insert a node with attribute "a" after "p".  */
+
+static void
+pad_node (NODE_T *p, enum a68_attribute a)
+{
+  /* This is used to fill information that Algol 68 does not require to be
+     present.  Filling in gives one format for such construct; this helps later
+     passes.  */
+  NODE_T *z = a68_new_node ();
+  *z = *p;
+  if (GINFO (p) != NO_GINFO)
+    GINFO (z) = a68_new_genie_info ();
+  PREVIOUS (z) = p;
+  SUB (z) = NO_NODE;
+  ATTRIBUTE (z) = a;
+  MOID (z) = NO_MOID;
+  if (NEXT (z) != NO_NODE)
+    PREVIOUS (NEXT (z)) = z;
+  NEXT (p) = z;
+}
+
+/* Diagnose extensions.  */
+
+static void
+a68_extension (NODE_T *p)
+{
+  a68_warning (p, OPT_Wextensions, "AST node is an extension");
+}
+
+/* Diagnose for clauses not yielding a value.  */
+
+static void
+empty_clause (NODE_T *p)
+{
+  a68_error (p, "clause does not yield a value");
+}
+
+/* Diagnose for missing symbol.  */
+
+static void
+strange_tokens (NODE_T *p)
+{
+  NODE_T *q = ((p != NO_NODE && NEXT (p) != NO_NODE) ? NEXT (p) : p);
+  a68_error (q, "possibly a missing or erroneous symbol nearby");
+}
+
+/* Diagnose for strange separator.  */
+
+static void
+strange_separator (NODE_T *p)
+{
+  NODE_T *q = ((p != NO_NODE && NEXT (p) != NO_NODE) ? NEXT (p) : p);
+  a68_error (q, "possibly a missing or erroneous separator nearby");
+}
+
+/* If match then reduce a sentence, the core bottom-up parser routine.  */
+
+static void
+reduce (NODE_T *p, void (*a) (NODE_T *), bool *z, ...)
+{
+  va_list list;
+  va_start (list, z);
+  enum a68_attribute expect;
+  enum a68_attribute result = (enum a68_attribute) va_arg (list, int);
+  NODE_T *head = p, *tail = NO_NODE;
+
+  while ((expect = (enum a68_attribute) va_arg (list, int)) != STOP)
+  {
+    bool keep_matching;
+
+    if (p == NO_NODE)
+      keep_matching = false;
+    else if (expect == WILDCARD)
+      /* WILDCARD matches any Algol68G non terminal, but no keyword.  */
+      keep_matching = (a68_attribute_name (ATTRIBUTE (p)) != NO_TEXT);
+    else
+      {
+	if (expect == SKIP)
+	  {
+	    /* Stray "~" matches expected SKIP.  */
+	    if (IS (p, OPERATOR) && IS_LITERALLY (p, "~"))
+	      ATTRIBUTE (p) = SKIP;
+	  }
+
+	if (expect >= 0)
+	  keep_matching = (expect == ATTRIBUTE (p));
+	else
+	  keep_matching = (expect != ATTRIBUTE (p));
+      }
+
+    if (keep_matching)
+      {
+	tail = p;
+	FORWARD (p);
+      }
+    else
+      {
+	va_end (list);
+	return;
+      }
+  }
+
+  /* Make reduction.  */
+  if (a != NO_NOTE)
+    a (head);
+
+  a68_make_sub (head, tail, result);
+  va_end (list);
+  if (z != NO_TICK)
+    *z = true;
+}
+
+/* Graciously ignore extra semicolons.  */
+
+static void
+ignore_superfluous_semicolons (NODE_T *p)
+{
+  /* This routine relaxes the parser a bit with respect to superfluous
+     semicolons, for instance "FI; OD". These provoke only a warning.  */
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      ignore_superfluous_semicolons (SUB (p));
+
+      if (NEXT (p) != NO_NODE && IS (NEXT (p), SEMI_SYMBOL) && NEXT_NEXT (p) == NO_NODE)
+	{
+	  a68_warning (NEXT (p), 0,
+		       "skipped superfluous A", ATTRIBUTE (NEXT (p)));
+	  NEXT (p) = NO_NODE;
+	}
+      else if (IS (p, SEMI_SYMBOL) && a68_is_semicolon_less (NEXT (p)))
+	{
+	  a68_warning (p, 0,
+		       "skipped superfluous A", ATTRIBUTE (p));
+	  if (PREVIOUS (p) != NO_NODE)
+	    NEXT (PREVIOUS (p)) = NEXT (p);
+	  PREVIOUS (NEXT (p)) = PREVIOUS (p);
+	}
+    }
+}
+
+/* Driver for the bottom-up parser.  */
+
+void
+a68_bottom_up_parser (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (!setjmp (A68_PARSER (bottom_up_crash_exit)))
+	{
+	  NODE_T *q;
+	  int error_count_0 = ERROR_COUNT (&A68_JOB);
+
+	  ignore_superfluous_semicolons (p);
+	  /* A program is "label sequence; particular program".  */
+	  a68_extract_labels (p, SERIAL_CLAUSE);
+	  /* Parse the program itself.  */
+	  for (q = p; q != NO_NODE; FORWARD (q))
+	    {
+	      bool siga = true;
+
+	      if (SUB (q) != NO_NODE)
+		reduce_branch (q, SOME_CLAUSE);
+	      while (siga)
+		{
+		  siga = false;
+		  reduce (q, NO_NOTE, &siga, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP);
+		  reduce (q, NO_NOTE, &siga, LABEL, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP);
+		}
+	    }
+	  /* Determine the encompassing enclosed clause.  */
+	  for (q = p; q != NO_NODE; FORWARD (q))
+	    {
+	      reduce (q, NO_NOTE, NO_TICK, PARALLEL_CLAUSE, PAR_SYMBOL, COLLATERAL_CLAUSE, STOP);
+	      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, PARALLEL_CLAUSE, STOP);
+	      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CLOSED_CLAUSE, STOP);
+	      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, COLLATERAL_CLAUSE, STOP);
+	      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONDITIONAL_CLAUSE, STOP);
+	      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CASE_CLAUSE, STOP);
+	      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONFORMITY_CLAUSE, STOP);
+	      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, LOOP_CLAUSE, STOP);
+	    }
+	  /* Try reducing the particular program.  */
+	  q = p;
+	  reduce (q, NO_NOTE, NO_TICK, PARTICULAR_PROGRAM, LABEL, ENCLOSED_CLAUSE, STOP);
+	  reduce (q, NO_NOTE, NO_TICK, PARTICULAR_PROGRAM, ENCLOSED_CLAUSE, STOP);
+	  if (SUB (p) == NO_NODE || NEXT (p) != NO_NODE)
+	    recover_from_error (p, PARTICULAR_PROGRAM,
+				((ERROR_COUNT (&A68_JOB) - error_count_0) > MAX_ERRORS));
+	}
+    }
+}
+
+/* Reduce the sub-phrase that starts one level down.  */
+
+static void
+reduce_branch (NODE_T *q, enum a68_attribute expect)
+{
+  /* If unsuccessful then the routine will at least copy the resulting
+     attribute as the parser can repair some faults. This gives less spurious
+     diagnostics.  */
+  if (q != NO_NODE && SUB (q) != NO_NODE)
+    {
+      NODE_T *p = SUB (q), *u = NO_NODE;
+      int error_count_0 = ERROR_COUNT (&A68_JOB), error_count_02;
+      bool declarer_pack = false, no_error;
+
+      switch (expect)
+	{
+	case STRUCTURE_PACK:
+	case PARAMETER_PACK:
+	case FORMAL_DECLARERS:
+	case UNION_PACK:
+	case SPECIFIER:
+	  declarer_pack = true;
+	  break;
+	default:
+	  declarer_pack = false;
+	}
+
+      /* Sample all info needed to decide whether a bold tag is operator or
+	 indicant.  Find the meaning of bold tags and quit in case of extra
+	 errors.  */
+      a68_extract_indicants (p);
+      if (!declarer_pack)
+	{
+	  a68_extract_priorities (p);
+	  a68_extract_operators (p);
+	}
+
+      error_count_02 = ERROR_COUNT (&A68_JOB);
+      a68_elaborate_bold_tags (p);
+      if ((ERROR_COUNT (&A68_JOB) - error_count_02) > 0)
+	longjmp (A68_PARSER (bottom_up_crash_exit), 1);
+
+      /* Now we can reduce declarers, knowing which bold tags are indicants.  */
+      reduce_declarers (p, expect);
+      /* Parse the phrase, as appropriate.  */
+      if (declarer_pack == false)
+	{
+	  error_count_02 = ERROR_COUNT (&A68_JOB);
+	  a68_extract_declarations (p);
+	  if ((ERROR_COUNT (&A68_JOB) - error_count_02) > 0)
+	    longjmp (A68_PARSER (bottom_up_crash_exit), 1);
+	  a68_extract_labels (p, expect);
+	  for (u = p; u != NO_NODE; FORWARD (u))
+	    {
+	      if (SUB (u) != NO_NODE)
+		{
+		  if (IS (u, FORMAT_DELIMITER_SYMBOL))
+		    reduce_branch (u, FORMAT_TEXT);
+		  else if (IS (u, FORMAT_OPEN_SYMBOL))
+		    reduce_branch (u, FORMAT_TEXT);
+		  else if (IS (u, OPEN_SYMBOL))
+		    {
+		      if (NEXT (u) != NO_NODE && IS (NEXT (u), THEN_BAR_SYMBOL))
+			reduce_branch (u, ENQUIRY_CLAUSE);
+		      else if (PREVIOUS (u) != NO_NODE && IS (PREVIOUS (u), PAR_SYMBOL))
+			reduce_branch (u, COLLATERAL_CLAUSE);
+		    }
+		  else if (a68_is_one_of (u, IF_SYMBOL, ELIF_SYMBOL, CASE_SYMBOL,
+					  OUSE_SYMBOL, WHILE_SYMBOL,
+					  ELSE_BAR_SYMBOL, STOP))
+		    reduce_branch (u, ENQUIRY_CLAUSE);
+		  else if (IS (u, BEGIN_SYMBOL))
+		    reduce_branch (u, SOME_CLAUSE);
+		  else if (a68_is_one_of (u, THEN_SYMBOL, ELSE_SYMBOL, OUT_SYMBOL,
+					  DO_SYMBOL, ALT_DO_SYMBOL, STOP))
+		    reduce_branch (u, SERIAL_CLAUSE);
+		  else if (IS (u, IN_SYMBOL))
+		    reduce_branch (u, COLLATERAL_CLAUSE);
+		  else if (IS (u, THEN_BAR_SYMBOL))
+		    reduce_branch (u, SOME_CLAUSE);
+		 else if (IS (u, LOOP_CLAUSE))
+		   reduce_branch (u, ENCLOSED_CLAUSE);
+		 else if (a68_is_one_of (u, FOR_SYMBOL, FROM_SYMBOL, BY_SYMBOL, TO_SYMBOL,
+					 STOP))
+		   reduce_branch (u, UNIT);
+		}
+	    }
+
+	  reduce_primary_parts (p, expect);
+	  if (expect != ENCLOSED_CLAUSE) {
+	    reduce_primaries (p, expect);
+	    if (expect == FORMAT_TEXT)
+	      reduce_format_texts (p);
+	    else
+	      {
+		reduce_secondaries (p);
+		reduce_formulae (p);
+		reduce_tertiaries (p);
+	      }
+	  }
+
+	  reduce_right_to_left_constructs (p);
+	  /* Reduce units and declarations.  */
+	  reduce_basic_declarations (p);
+	  reduce_units (p);
+	  reduce_erroneous_units (p);
+	  if (expect != UNIT)
+	    {
+	      if (expect == GENERIC_ARGUMENT)
+		reduce_generic_arguments (p);
+	      else if (expect == BOUNDS)
+		reduce_bounds (p);
+	      else
+		{
+		  reduce_declaration_lists (p);
+		  if (expect != DECLARATION_LIST)
+		    {
+		      for (u = p; u != NO_NODE; FORWARD (u))
+			{
+			  reduce (u, NO_NOTE, NO_TICK, LABELED_UNIT, LABEL, UNIT, STOP);
+			  reduce (u, NO_NOTE, NO_TICK, SPECIFIED_UNIT, SPECIFIER,
+				  COLON_SYMBOL, UNIT, STOP);
+			}
+		      if (expect == SOME_CLAUSE)
+			expect = serial_or_collateral (p);
+		      if (expect == SERIAL_CLAUSE)
+			reduce_serial_clauses (p);
+		      else if (expect == ENQUIRY_CLAUSE)
+			reduce_enquiry_clauses (p);
+		      else if (expect == COLLATERAL_CLAUSE)
+			reduce_collateral_clauses (p);
+		      else if (expect == ARGUMENT)
+			reduce_arguments (p);
+		    }
+		}
+	    }
+	  reduce_enclosed_clauses (p, expect);
+	}
+
+      /* Do something if parsing failed.  */
+      if (SUB (p) == NO_NODE || NEXT (p) != NO_NODE)
+	{
+	  recover_from_error (p, expect,
+			      ((ERROR_COUNT (&A68_JOB) - error_count_0) > MAX_ERRORS));
+	  no_error = false;
+	}
+      else
+	no_error = true;
+      ATTRIBUTE (q) = ATTRIBUTE (p);
+      if (no_error)
+	SUB (q) = SUB (p);
+    }
+}
+
+/* Driver for reducing declarers.  */
+
+static void
+reduce_declarers (NODE_T *p, enum a68_attribute expect)
+{
+  NODE_T *q; bool siga; /* Must be in this scope.  */
+
+  /* Reduce lengtheties.  */
+  for (q = p; q != NO_NODE; FORWARD (q))
+    {
+      siga = true;
+      reduce (q, NO_NOTE, NO_TICK, LONGETY, LONG_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, SHORTETY, SHORT_SYMBOL, STOP);
+      while (siga)
+	{
+	  siga = false;
+	  reduce (q, NO_NOTE, &siga, LONGETY, LONGETY, LONG_SYMBOL, STOP);
+	  reduce (q, NO_NOTE, &siga, SHORTETY, SHORTETY, SHORT_SYMBOL, STOP);
+	}
+    }
+
+  /* Reduce indicants.  */
+  for (q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, INDICANT, INT_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INDICANT, REAL_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INDICANT, BITS_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INDICANT, BYTES_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INDICANT, COMPLEX_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INDICANT, COMPL_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INDICANT, BOOL_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INDICANT, CHAR_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INDICANT, FORMAT_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INDICANT, STRING_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INDICANT, FILE_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INDICANT, CHANNEL_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INDICANT, SEMA_SYMBOL, STOP);
+    }
+
+  /* Reduce standard stuff.  */
+  for (q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (a68_whether (q, LONGETY, INDICANT, STOP))
+	{
+	  int a;
+
+	  if (SUB_NEXT (q) == NO_NODE)
+	    {
+	      a68_error (NEXT (q),
+			 "Y expected", "appropriate declarer");
+	      reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP);
+	    }
+	  else
+	    {
+	      a = ATTRIBUTE (SUB_NEXT (q));
+
+	      if (a == INT_SYMBOL || a == REAL_SYMBOL || a == BITS_SYMBOL
+		  || a == BYTES_SYMBOL || a == COMPLEX_SYMBOL
+		  || a == COMPL_SYMBOL)
+		{
+		  reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP);
+		}
+	      else
+		{
+		  a68_error (NEXT (q),
+			     "Y expected", "appropriate declarer");
+		  reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP);
+		}
+	    }
+	}
+      else if (a68_whether (q, SHORTETY, INDICANT, STOP))
+	{
+	  int a;
+
+	  if (SUB_NEXT (q) == NO_NODE)
+	    {
+	      a68_error (NEXT (q),
+			 "Y expected", "appropriate declarer");
+	      reduce (q, NO_NOTE, NO_TICK, DECLARER, SHORTETY, INDICANT, STOP);
+	    }
+	  else
+	    {
+	      a = ATTRIBUTE (SUB_NEXT (q));
+	      if (a == INT_SYMBOL || a == REAL_SYMBOL || a == BITS_SYMBOL
+		  || a == BYTES_SYMBOL || a == COMPLEX_SYMBOL || a == COMPL_SYMBOL)
+		{
+		  reduce (q, NO_NOTE, NO_TICK, DECLARER, SHORTETY, INDICANT, STOP);
+		}
+	      else
+		{
+		  a68_error (NEXT (q),
+			     "Y expected", "appropriate declarer");
+		  reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP);
+		}
+	    }
+	}
+    }
+
+  for (q = p; q != NO_NODE; FORWARD (q))
+    reduce (q, NO_NOTE, NO_TICK, DECLARER, INDICANT, STOP);
+
+  /* Reduce declarer lists.  */
+  for (q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (NEXT (q) != NO_NODE && SUB_NEXT (q) != NO_NODE)
+	{
+	  if (IS (q, STRUCT_SYMBOL))
+	    {
+	      reduce_branch (NEXT (q), STRUCTURE_PACK);
+	      reduce (q, NO_NOTE, NO_TICK, DECLARER, STRUCT_SYMBOL, STRUCTURE_PACK, STOP);
+	    }
+	  else if (IS (q, UNION_SYMBOL))
+	    {
+	      reduce_branch (NEXT (q), UNION_PACK);
+	      reduce (q, NO_NOTE, NO_TICK, DECLARER, UNION_SYMBOL, UNION_PACK, STOP);
+	    }
+	  else if (IS (q, PROC_SYMBOL))
+	    {
+	      if (a68_whether (q, PROC_SYMBOL, OPEN_SYMBOL, STOP))
+		{
+		  if (!a68_is_formal_bounds (SUB_NEXT (q)))
+		    reduce_branch (NEXT (q), FORMAL_DECLARERS);
+		}
+	    }
+	  else if (IS (q, OP_SYMBOL))
+	    {
+	      if (a68_whether (q, OP_SYMBOL, OPEN_SYMBOL, STOP))
+		{
+		  if (!a68_is_formal_bounds (SUB_NEXT (q)))
+		    reduce_branch (NEXT (q), FORMAL_DECLARERS);
+		}
+	    }
+	}
+    }
+
+  /* Reduce row, proc or op declarers.  */
+  siga = true;
+  while (siga)
+    {
+    siga = false;
+
+    for (q = p; q != NO_NODE; FORWARD (q))
+      {
+	/* FLEX DECL.  */
+	if (a68_whether (q, FLEX_SYMBOL, DECLARER, STOP))
+	  reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, DECLARER, STOP);
+
+	/* FLEX [] DECL.  */
+	if (a68_whether (q, FLEX_SYMBOL, SUB_SYMBOL, DECLARER, STOP) && SUB_NEXT (q) != NO_NODE)
+	  {
+	    reduce_branch (NEXT (q), BOUNDS);
+	    reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, BOUNDS, DECLARER, STOP);
+	    reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, FORMAL_BOUNDS, DECLARER, STOP);
+	  }
+
+	/* FLEX () DECL.  */
+	if (a68_whether (q, FLEX_SYMBOL, OPEN_SYMBOL, DECLARER, STOP) && SUB_NEXT (q) != NO_NODE)
+	  {
+	    if (!a68_whether (q, FLEX_SYMBOL, OPEN_SYMBOL, DECLARER, COLON_SYMBOL, STOP))
+	      {
+		reduce_branch (NEXT (q), BOUNDS);
+		reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, BOUNDS, DECLARER, STOP);
+		reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, FORMAL_BOUNDS, DECLARER, STOP);
+	      }
+	  }
+
+	/* [] DECL.  */
+	if (a68_whether (q, SUB_SYMBOL, DECLARER, STOP) && SUB (q) != NO_NODE)
+	  {
+	    reduce_branch (q, BOUNDS);
+	    reduce (q, NO_NOTE, &siga, DECLARER, BOUNDS, DECLARER, STOP);
+	    reduce (q, NO_NOTE, &siga, DECLARER, FORMAL_BOUNDS, DECLARER, STOP);
+	  }
+
+	/* () DECL.  */
+	if (a68_whether (q, OPEN_SYMBOL, DECLARER, STOP) && SUB (q) != NO_NODE)
+	  {
+	    if (a68_whether (q, OPEN_SYMBOL, DECLARER, COLON_SYMBOL, STOP))
+	      {
+		/* Catch e.g. (INT i) () INT:.  */
+		if (a68_is_formal_bounds (SUB (q)))
+		  {
+		    reduce_branch (q, BOUNDS);
+		    reduce (q, NO_NOTE, &siga, DECLARER, BOUNDS, DECLARER, STOP);
+		    reduce (q, NO_NOTE, &siga, DECLARER, FORMAL_BOUNDS, DECLARER, STOP);
+		  }
+	      }
+	    else
+	      {
+		reduce_branch (q, BOUNDS);
+		reduce (q, NO_NOTE, &siga, DECLARER, BOUNDS, DECLARER, STOP);
+		reduce (q, NO_NOTE, &siga, DECLARER, FORMAL_BOUNDS, DECLARER, STOP);
+	      }
+	  }
+      }
+
+    /* PROC DECL, PROC () DECL, OP () DECL.  */
+    for (q = p; q != NO_NODE; FORWARD (q))
+      {
+	int a = ATTRIBUTE (q);
+	if (a == REF_SYMBOL)
+	  reduce (q, NO_NOTE, &siga, DECLARER, REF_SYMBOL, DECLARER, STOP);
+	else if (a == PROC_SYMBOL)
+	  {
+	    reduce (q, NO_NOTE, &siga, DECLARER, PROC_SYMBOL, DECLARER, STOP);
+	    reduce (q, NO_NOTE, &siga, DECLARER, PROC_SYMBOL, FORMAL_DECLARERS, DECLARER, STOP);
+	    reduce (q, NO_NOTE, &siga, DECLARER, PROC_SYMBOL, VOID_SYMBOL, STOP);
+	    reduce (q, NO_NOTE, &siga, DECLARER, PROC_SYMBOL, FORMAL_DECLARERS, VOID_SYMBOL, STOP);
+	  }
+	else if (a == OP_SYMBOL)
+	  {
+	    reduce (q, NO_NOTE, &siga, OPERATOR_PLAN, OP_SYMBOL, FORMAL_DECLARERS, DECLARER, STOP);
+	    reduce (q, NO_NOTE, &siga, OPERATOR_PLAN, OP_SYMBOL, FORMAL_DECLARERS, VOID_SYMBOL, STOP);
+	  }
+      }
+    }
+
+  /* Reduce packs etcetera.  */
+  if (expect == STRUCTURE_PACK)
+    {
+      for (q = p; q != NO_NODE; FORWARD (q))
+	{
+	  siga = true;
+	  while (siga)
+	    {
+	      siga = false;
+	      reduce (q, NO_NOTE, &siga, STRUCTURED_FIELD, DECLARER, IDENTIFIER, STOP);
+	      reduce (q, NO_NOTE, &siga, STRUCTURED_FIELD, STRUCTURED_FIELD, COMMA_SYMBOL, IDENTIFIER, STOP);
+	    }
+	}
+
+      for (q = p; q != NO_NODE; FORWARD (q))
+	{
+	  siga = true;
+	  while (siga)
+	    {
+	      siga = false;
+	      reduce (q, NO_NOTE, &siga, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD, STOP);
+	      reduce (q, NO_NOTE, &siga, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD_LIST,
+		      COMMA_SYMBOL, STRUCTURED_FIELD, STOP);
+	      reduce (q, strange_separator, &siga, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD_LIST,
+		      STRUCTURED_FIELD, STOP);
+	      reduce (q, strange_separator, &siga, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD_LIST,
+		      SEMI_SYMBOL, STRUCTURED_FIELD, STOP);
+	    }
+	}
+    q = p;
+    reduce (q, NO_NOTE, NO_TICK, STRUCTURE_PACK, OPEN_SYMBOL, STRUCTURED_FIELD_LIST,
+	    CLOSE_SYMBOL, STOP);
+    }
+  else if (expect == PARAMETER_PACK)
+    {
+      for (q = p; q != NO_NODE; FORWARD (q))
+	{
+	  siga = true;
+	  while (siga)
+	    {
+	      siga = false;
+	      reduce (q, NO_NOTE, &siga, PARAMETER, DECLARER, IDENTIFIER, STOP);
+	      reduce (q, NO_NOTE, &siga, PARAMETER, PARAMETER, COMMA_SYMBOL, IDENTIFIER, STOP);
+	    }
+	}
+
+      for (q = p; q != NO_NODE; FORWARD (q))
+	{
+	  siga = true;
+	  while (siga)
+	    {
+	      siga = false;
+	      reduce (q, NO_NOTE, &siga, PARAMETER_LIST, PARAMETER, STOP);
+	      reduce (q, NO_NOTE, &siga, PARAMETER_LIST, PARAMETER_LIST, COMMA_SYMBOL, PARAMETER, STOP);
+	    }
+	}
+      q = p;
+      reduce (q, NO_NOTE, NO_TICK, PARAMETER_PACK, OPEN_SYMBOL, PARAMETER_LIST,
+	      CLOSE_SYMBOL, STOP);
+    }
+  else if (expect == FORMAL_DECLARERS)
+    {
+      for (q = p; q != NO_NODE; FORWARD (q))
+	{
+	  siga = true;
+	  while (siga)
+	    {
+	      siga = false;
+	      reduce (q, NO_NOTE, &siga, FORMAL_DECLARERS_LIST, DECLARER, STOP);
+	      reduce (q, NO_NOTE, &siga, FORMAL_DECLARERS_LIST, FORMAL_DECLARERS_LIST,
+		      COMMA_SYMBOL, DECLARER, STOP);
+	      reduce (q, strange_separator, &siga, FORMAL_DECLARERS_LIST, FORMAL_DECLARERS_LIST,
+		      SEMI_SYMBOL, DECLARER, STOP);
+	      reduce (q, strange_separator, &siga, FORMAL_DECLARERS_LIST, FORMAL_DECLARERS_LIST,
+		      DECLARER, STOP);
+	    }
+	}
+      q = p;
+      reduce (q, NO_NOTE, NO_TICK, FORMAL_DECLARERS, OPEN_SYMBOL, FORMAL_DECLARERS_LIST,
+	      CLOSE_SYMBOL, STOP);
+    }
+  else if (expect == UNION_PACK)
+    {
+      for (q = p; q != NO_NODE; FORWARD (q))
+	{
+	  siga = true;
+	  while (siga)
+	    {
+	      siga = false;
+	      reduce (q, NO_NOTE, &siga, UNION_DECLARER_LIST, DECLARER, STOP);
+	      reduce (q, NO_NOTE, &siga, UNION_DECLARER_LIST, VOID_SYMBOL, STOP);
+	      reduce (q, NO_NOTE, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST,
+		      COMMA_SYMBOL, DECLARER, STOP);
+	      reduce (q, NO_NOTE, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST,
+		      COMMA_SYMBOL, VOID_SYMBOL, STOP);
+	      reduce (q, strange_separator, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST,
+		      SEMI_SYMBOL, DECLARER, STOP);
+	      reduce (q, strange_separator, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST,
+		      SEMI_SYMBOL, VOID_SYMBOL, STOP);
+	      reduce (q, strange_separator, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST,
+		      DECLARER, STOP);
+	      reduce (q, strange_separator, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST,
+		      VOID_SYMBOL, STOP);
+	    }
+	}
+      q = p;
+      reduce (q, NO_NOTE, NO_TICK, UNION_PACK, OPEN_SYMBOL, UNION_DECLARER_LIST,
+	      CLOSE_SYMBOL, STOP);
+    }
+  else if (expect == SPECIFIER)
+    {
+      reduce (p, NO_NOTE, NO_TICK, SPECIFIER, OPEN_SYMBOL, DECLARER, IDENTIFIER, CLOSE_SYMBOL, STOP);
+      reduce (p, NO_NOTE, NO_TICK, SPECIFIER, OPEN_SYMBOL, DECLARER, CLOSE_SYMBOL, STOP);
+      reduce (p, NO_NOTE, NO_TICK, SPECIFIER, OPEN_SYMBOL, VOID_SYMBOL, CLOSE_SYMBOL, STOP);
+    }
+  else
+    {
+      for (q = p; q != NO_NODE; FORWARD (q))
+	{
+	  if (a68_whether (q, OPEN_SYMBOL, COLON_SYMBOL, STOP)
+	      && !(expect == GENERIC_ARGUMENT || expect == BOUNDS))
+	    {
+	      if (a68_is_one_of (p, IN_SYMBOL, THEN_BAR_SYMBOL, STOP))
+		reduce_branch (q, SPECIFIER);
+	    }
+	  if (a68_whether (q, OPEN_SYMBOL, DECLARER, COLON_SYMBOL, STOP))
+	    reduce_branch (q, PARAMETER_PACK);
+	  if (a68_whether (q, OPEN_SYMBOL, VOID_SYMBOL, COLON_SYMBOL, STOP))
+	    reduce_branch (q, PARAMETER_PACK);
+	}
+    }
+}
+
+/* Handle cases that need reducing from right-to-left.  */
+
+static void
+reduce_right_to_left_constructs (NODE_T *p)
+{
+  /* Here are cases that need reducing from right-to-left whereas many things
+     can be reduced left-to-right. Assignations are a notable example; one
+     could discuss whether it would not be more natural to write 1 =: k instead
+     of k := 1. (jemarch: MARY did just that.)  The latter is said to be more
+     natural, or it could be just computing history. Meanwhile we use this
+     routine.  */
+
+  if (p != NO_NODE)
+    {
+      reduce_right_to_left_constructs (NEXT (p));
+      /* Assignations.  */
+      if (IS (p, TERTIARY))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, TERTIARY, STOP);
+	  reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, IDENTITY_RELATION, STOP);
+	  reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, AND_FUNCTION, STOP);
+	  reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, OR_FUNCTION, STOP);
+	  reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, ROUTINE_TEXT, STOP);
+	  reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, JUMP, STOP);
+	  reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, SKIP, STOP);
+	  reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, ASSIGNATION, STOP);
+	}
+
+      /* Routine texts with parameter pack.  */
+    else if (IS (p, PARAMETER_PACK))
+      {
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, ASSIGNATION, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, IDENTITY_RELATION, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL,AND_FUNCTION, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, OR_FUNCTION, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, JUMP, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, SKIP, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, TERTIARY, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, ROUTINE_TEXT, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, ASSIGNATION, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, IDENTITY_RELATION, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, AND_FUNCTION, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, OR_FUNCTION, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, JUMP, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, SKIP, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, TERTIARY, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, ROUTINE_TEXT, STOP);
+      }
+      /* Routine texts without parameter pack. */
+    else if (IS (p, DECLARER))
+      {
+	if (!(PREVIOUS (p) != NO_NODE && IS (PREVIOUS (p), PARAMETER_PACK)))
+	  {
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, ASSIGNATION, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, IDENTITY_RELATION, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, AND_FUNCTION, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, OR_FUNCTION, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, JUMP, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, SKIP, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, TERTIARY, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, ROUTINE_TEXT, STOP);
+	  }
+      }
+    else if (IS (p, VOID_SYMBOL))
+      {
+	if (!(PREVIOUS (p) != NO_NODE && IS (PREVIOUS (p), PARAMETER_PACK)))
+	  {
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, ASSIGNATION, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, IDENTITY_RELATION, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, AND_FUNCTION, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, OR_FUNCTION, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, JUMP, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, SKIP, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, TERTIARY, STOP);
+	    reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, ROUTINE_TEXT, STOP);
+	  }
+      }
+    }
+}
+
+/* Reduce primary elements.  */
+
+static void
+reduce_primary_parts (NODE_T *p, enum a68_attribute expect)
+{
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (a68_whether (q, IDENTIFIER, OF_SYMBOL, STOP))
+	ATTRIBUTE (q) = FIELD_IDENTIFIER;
+
+      reduce (q, NO_NOTE, NO_TICK, NIHIL, NIL_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, SKIP, SKIP_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, SELECTOR, FIELD_IDENTIFIER, OF_SYMBOL, STOP);
+      /* JUMPs without GOTO are resolved later.  */
+      reduce (q, NO_NOTE, NO_TICK, JUMP, GOTO_SYMBOL, IDENTIFIER, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DENOTATION, LONGETY, INT_DENOTATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DENOTATION, LONGETY, REAL_DENOTATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DENOTATION, LONGETY, BITS_DENOTATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DENOTATION, SHORTETY, INT_DENOTATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DENOTATION, SHORTETY, REAL_DENOTATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DENOTATION, SHORTETY, BITS_DENOTATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DENOTATION, INT_DENOTATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DENOTATION, REAL_DENOTATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DENOTATION, BITS_DENOTATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DENOTATION, ROW_CHAR_DENOTATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DENOTATION, TRUE_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DENOTATION, FALSE_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DENOTATION, EMPTY_SYMBOL, STOP);
+      if (expect == SERIAL_CLAUSE || expect == ENQUIRY_CLAUSE || expect == SOME_CLAUSE)
+	{
+	  bool siga = true;
+	  while (siga)
+	    {
+	      siga = false;
+	      reduce (q, NO_NOTE, &siga, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP);
+	      reduce (q, NO_NOTE, &siga, LABEL, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP);
+	    }
+	}
+    }
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, PARALLEL_CLAUSE, PAR_SYMBOL, COLLATERAL_CLAUSE, STOP);
+      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, PARALLEL_CLAUSE, STOP);
+      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CLOSED_CLAUSE, STOP);
+      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, COLLATERAL_CLAUSE, STOP);
+      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONDITIONAL_CLAUSE, STOP);
+      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CASE_CLAUSE, STOP);
+      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONFORMITY_CLAUSE, STOP);
+      reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, LOOP_CLAUSE, STOP);
+    }
+}
+
+/* Reduce primaries completely.  */
+
+static void
+reduce_primaries (NODE_T *p, enum a68_attribute expect)
+{
+  NODE_T *q = p;
+  while (q != NO_NODE)
+    {
+      bool fwd = true, siga;
+      /* Primaries excepts call and slice.  */
+      reduce (q, NO_NOTE, NO_TICK, PRIMARY, IDENTIFIER, STOP);
+      reduce (q, NO_NOTE, NO_TICK, PRIMARY, DENOTATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, CAST, DECLARER, ENCLOSED_CLAUSE, STOP);
+      reduce (q, NO_NOTE, NO_TICK, CAST, VOID_SYMBOL, ENCLOSED_CLAUSE, STOP);
+      reduce (q, NO_NOTE, NO_TICK, ASSERTION, ASSERT_SYMBOL, ENCLOSED_CLAUSE, STOP);
+      reduce (q, NO_NOTE, NO_TICK, PRIMARY, CAST, STOP);
+      reduce (q, NO_NOTE, NO_TICK, PRIMARY, ENCLOSED_CLAUSE, STOP);
+      reduce (q, NO_NOTE, NO_TICK, PRIMARY, FORMAT_TEXT, STOP);
+      /* Call and slice.  */
+      siga = true;
+      while (siga)
+	{
+	  NODE_T *x = NEXT (q);
+
+	  siga = false;
+	  if (IS (q, PRIMARY) && x != NO_NODE)
+	    {
+	      if (IS (x, OPEN_SYMBOL))
+		{
+		  reduce_branch (NEXT (q), GENERIC_ARGUMENT);
+		  reduce (q, NO_NOTE, &siga, SPECIFICATION, PRIMARY, GENERIC_ARGUMENT, STOP);
+		  reduce (q, NO_NOTE, &siga, PRIMARY, SPECIFICATION, STOP);
+		}
+	      else if (IS (x, SUB_SYMBOL))
+		{
+		  reduce_branch (NEXT (q), GENERIC_ARGUMENT);
+		  reduce (q, NO_NOTE, &siga, SPECIFICATION, PRIMARY, GENERIC_ARGUMENT, STOP);
+		  reduce (q, NO_NOTE, &siga, PRIMARY, SPECIFICATION, STOP);
+		}
+	    }
+	}
+
+      /* Now that call and slice are known, reduce remaining ( .. ).  */
+      if (IS (q, OPEN_SYMBOL) && SUB (q) != NO_NODE)
+	{
+	  reduce_branch (q, SOME_CLAUSE);
+	  reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CLOSED_CLAUSE, STOP);
+	  reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, COLLATERAL_CLAUSE, STOP);
+	  reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONDITIONAL_CLAUSE, STOP);
+	  reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CASE_CLAUSE, STOP);
+	  reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONFORMITY_CLAUSE, STOP);
+	  if (PREVIOUS (q) != NO_NODE)
+	    {
+	      BACKWARD (q);
+	      fwd = false;
+	    }
+	}
+
+      /* Format text items.  */
+      if (expect == FORMAT_TEXT)
+	{
+	  NODE_T *r;
+
+	  for (r = p; r != NO_NODE; FORWARD (r))
+	    {
+	      reduce (r, NO_NOTE, NO_TICK, DYNAMIC_REPLICATOR, FORMAT_ITEM_N, ENCLOSED_CLAUSE, STOP);
+	      reduce (r, NO_NOTE, NO_TICK, GENERAL_PATTERN, FORMAT_ITEM_G, ENCLOSED_CLAUSE, STOP);
+	      reduce (r, NO_NOTE, NO_TICK, GENERAL_PATTERN, FORMAT_ITEM_H, ENCLOSED_CLAUSE, STOP);
+	      reduce (r, NO_NOTE, NO_TICK, FORMAT_PATTERN, FORMAT_ITEM_F, ENCLOSED_CLAUSE, STOP);
+	    }
+	}
+      if (fwd)
+	FORWARD (q);
+    }
+}
+
+/* Enforce that ambiguous patterns are separated by commas.  */
+
+static void
+ambiguous_patterns (NODE_T *p)
+{
+  /* Example: printf (($+d.2d +d.2d$, 1, 2)) can produce either "+1.00 +2.00"
+     or "+1+002.00". A comma must be supplied to resolve the ambiguity.
+
+     The obvious thing would be to weave this into the syntax, letting the BU
+     parser sort it out. But the C-style patterns do not suffer from Algol 68
+     pattern ambiguity, so by solving it this way we maximise freedom in
+     writing the patterns as we want without introducing two "kinds" of
+     patterns, and so we have shorter routines for implementing formatted
+     transput. This is a pragmatic system.  */
+  NODE_T *q, *last_pat = NO_NODE;
+
+  for (q = p; q != NO_NODE; FORWARD (q))
+    {
+      switch (ATTRIBUTE (q))
+	{
+	  /* These are the potentially ambiguous patterns.  */
+	case INTEGRAL_PATTERN:
+	case REAL_PATTERN:
+	case COMPLEX_PATTERN:
+	case BITS_PATTERN:
+	  if (last_pat != NO_NODE)
+	    a68_error (q, "A and A must be separated by a comma-symbol",
+		       ATTRIBUTE (last_pat), ATTRIBUTE (q));
+	  last_pat = q;
+	  break;
+	case COMMA_SYMBOL:
+	  last_pat = NO_NODE;
+	  break;
+	default:
+	  break;
+	}
+    }
+}
+
+/* Reduce C format texts completely.  */
+
+static void
+reduce_c_pattern (NODE_T *p, int pr, int let)
+{
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, REPLICATOR, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, REPLICATOR, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, FORMAT_ITEM_PLUS, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, FORMAT_ITEM_PLUS, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, FORMAT_ITEM_PLUS, REPLICATOR, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, FORMAT_ITEM_PLUS, REPLICATOR, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, REPLICATOR, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, REPLICATOR, FORMAT_ITEM_POINT, REPLICATOR, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_PLUS, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_PLUS, FORMAT_ITEM_POINT, REPLICATOR,
+	      let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_PLUS, REPLICATOR, let, STOP);
+      reduce (q, NO_NOTE, NO_TICK, pr,
+	      FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_PLUS, REPLICATOR, FORMAT_ITEM_POINT,
+	      REPLICATOR, let, STOP);
+  }
+}
+
+/* Reduce format texts completely.  */
+
+static void
+reduce_format_texts (NODE_T *p)
+{
+  /* Replicators.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, REPLICATOR, STATIC_REPLICATOR, STOP);
+      reduce (q, NO_NOTE, NO_TICK, REPLICATOR, DYNAMIC_REPLICATOR, STOP);
+    }
+
+  /* "OTHER" patterns.  */
+  reduce_c_pattern (p, BITS_C_PATTERN, FORMAT_ITEM_B);
+  reduce_c_pattern (p, BITS_C_PATTERN, FORMAT_ITEM_O);
+  reduce_c_pattern (p, BITS_C_PATTERN, FORMAT_ITEM_X);
+  reduce_c_pattern (p, CHAR_C_PATTERN, FORMAT_ITEM_C);
+  reduce_c_pattern (p, FIXED_C_PATTERN, FORMAT_ITEM_F);
+  reduce_c_pattern (p, FLOAT_C_PATTERN, FORMAT_ITEM_E);
+  reduce_c_pattern (p, GENERAL_C_PATTERN, FORMAT_ITEM_G);
+  reduce_c_pattern (p, INTEGRAL_C_PATTERN, FORMAT_ITEM_D);
+  reduce_c_pattern (p, INTEGRAL_C_PATTERN, FORMAT_ITEM_I);
+  reduce_c_pattern (p, STRING_C_PATTERN, FORMAT_ITEM_S);
+  /* Radix frames.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    reduce (q, NO_NOTE, NO_TICK, RADIX_FRAME, REPLICATOR, FORMAT_ITEM_R, STOP);
+
+  /* Insertions.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_X, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_Y, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_L, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_P, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_Q, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_K, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INSERTION, LITERAL, STOP);
+    }
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, INSERTION, REPLICATOR, INSERTION, STOP);
+    }
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      bool siga = true;
+      while (siga)
+	{
+	  siga = false;
+	  reduce (q, NO_NOTE, &siga, INSERTION, INSERTION, INSERTION, STOP);
+	}
+    }
+
+  /* Replicated suppressible frames.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, REPLICATOR, FORMAT_ITEM_S, FORMAT_ITEM_A, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, REPLICATOR, FORMAT_ITEM_S, FORMAT_ITEM_Z, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, REPLICATOR, FORMAT_ITEM_S, FORMAT_ITEM_D, STOP);
+    }
+
+  /* Suppressible frames.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_A, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_Z, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_D, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_E_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_E, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_POINT_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_POINT, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_I_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_I, STOP);
+    }
+
+  /* Replicated frames.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, REPLICATOR, FORMAT_ITEM_A, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, REPLICATOR, FORMAT_ITEM_Z, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, REPLICATOR, FORMAT_ITEM_D, STOP);
+    }
+
+  /* Frames.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, FORMAT_ITEM_A, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, FORMAT_ITEM_Z, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, FORMAT_ITEM_D, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_E_FRAME, FORMAT_ITEM_E, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_POINT_FRAME, FORMAT_ITEM_POINT, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_I_FRAME, FORMAT_ITEM_I, STOP);
+    }
+
+  /* Frames with an insertion.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, INSERTION, FORMAT_A_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, INSERTION, FORMAT_Z_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, INSERTION, FORMAT_D_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_E_FRAME, INSERTION, FORMAT_E_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_POINT_FRAME, INSERTION, FORMAT_POINT_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMAT_I_FRAME, INSERTION, FORMAT_I_FRAME, STOP);
+    }
+
+  /* String patterns.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    reduce (q, NO_NOTE, NO_TICK, STRING_PATTERN, REPLICATOR, FORMAT_A_FRAME, STOP);
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    reduce (q, NO_NOTE, NO_TICK, STRING_PATTERN, FORMAT_A_FRAME, STOP);
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      bool siga = true;
+      while (siga)
+	{
+	  siga = false;
+	  reduce (q, NO_NOTE, &siga, STRING_PATTERN, STRING_PATTERN, STRING_PATTERN, STOP);
+	  reduce (q, NO_NOTE, &siga, STRING_PATTERN, STRING_PATTERN, INSERTION, STRING_PATTERN, STOP);
+	}
+    }
+
+  /* Integral moulds.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, INTEGRAL_MOULD, FORMAT_Z_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INTEGRAL_MOULD, FORMAT_D_FRAME, STOP);
+    }
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      bool siga = true;
+      while (siga)
+	{
+	  siga = false;
+	  reduce (q, NO_NOTE, &siga, INTEGRAL_MOULD, INTEGRAL_MOULD, INTEGRAL_MOULD, STOP);
+	  reduce (q, NO_NOTE, &siga, INTEGRAL_MOULD, INTEGRAL_MOULD, INSERTION, STOP);
+	}
+    }
+
+  /* Sign moulds.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_ITEM_PLUS, STOP);
+      reduce (q, NO_NOTE, NO_TICK, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_ITEM_MINUS, STOP);
+    }
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, SIGN_MOULD, FORMAT_ITEM_PLUS, STOP);
+      reduce (q, NO_NOTE, NO_TICK, SIGN_MOULD, FORMAT_ITEM_MINUS, STOP);
+    }
+
+  /* Exponent frames.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, EXPONENT_FRAME, FORMAT_E_FRAME, SIGN_MOULD, INTEGRAL_MOULD, STOP);
+      reduce (q, NO_NOTE, NO_TICK, EXPONENT_FRAME, FORMAT_E_FRAME, INTEGRAL_MOULD, STOP);
+    }
+
+  /* Real patterns.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK,
+	      REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, EXPONENT_FRAME,
+	      STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_POINT_FRAME, EXPONENT_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_POINT_FRAME, STOP);
+    }
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK,
+	      REAL_PATTERN, SIGN_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, EXPONENT_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, STOP);
+      reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, FORMAT_POINT_FRAME, EXPONENT_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, FORMAT_POINT_FRAME, STOP);
+    }
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK,
+	      REAL_PATTERN, INTEGRAL_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, EXPONENT_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      REAL_PATTERN, INTEGRAL_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      REAL_PATTERN, INTEGRAL_MOULD, FORMAT_POINT_FRAME, EXPONENT_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      REAL_PATTERN, INTEGRAL_MOULD, FORMAT_POINT_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      REAL_PATTERN, FORMAT_POINT_FRAME, INTEGRAL_MOULD, EXPONENT_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      REAL_PATTERN, FORMAT_POINT_FRAME, INTEGRAL_MOULD, STOP);
+  }
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, EXPONENT_FRAME, STOP);
+      reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, INTEGRAL_MOULD, EXPONENT_FRAME, STOP);
+    }
+
+  /* Complex patterns.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    reduce (q, NO_NOTE, NO_TICK, COMPLEX_PATTERN, REAL_PATTERN, FORMAT_I_FRAME, REAL_PATTERN, STOP);
+
+  /* Bits patterns.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    reduce (q, NO_NOTE, NO_TICK, BITS_PATTERN, RADIX_FRAME, INTEGRAL_MOULD, STOP);
+
+  /* Integral patterns.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, INTEGRAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INTEGRAL_PATTERN, INTEGRAL_MOULD, STOP);
+    }
+
+  /* Patterns.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, BOOLEAN_PATTERN, FORMAT_ITEM_B, COLLECTION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, CHOICE_PATTERN, FORMAT_ITEM_C, COLLECTION, STOP);
+    }
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, BOOLEAN_PATTERN, FORMAT_ITEM_B, STOP);
+      reduce (q, NO_NOTE, NO_TICK, GENERAL_PATTERN, FORMAT_ITEM_G, STOP);
+      reduce (q, NO_NOTE, NO_TICK, GENERAL_PATTERN, FORMAT_ITEM_H, STOP);
+    }
+
+  ambiguous_patterns (p);
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, a68_extension, NO_TICK, A68_PATTERN, BITS_C_PATTERN, STOP);
+      reduce (q, a68_extension, NO_TICK, A68_PATTERN, CHAR_C_PATTERN, STOP);
+      reduce (q, a68_extension, NO_TICK, A68_PATTERN, FIXED_C_PATTERN, STOP);
+      reduce (q, a68_extension, NO_TICK, A68_PATTERN, FLOAT_C_PATTERN, STOP);
+      reduce (q, a68_extension, NO_TICK, A68_PATTERN, GENERAL_C_PATTERN, STOP);
+      reduce (q, a68_extension, NO_TICK, A68_PATTERN, INTEGRAL_C_PATTERN, STOP);
+      reduce (q, a68_extension, NO_TICK, A68_PATTERN, STRING_C_PATTERN, STOP);
+      reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, BITS_PATTERN, STOP);
+      reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, BOOLEAN_PATTERN, STOP);
+      reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, CHOICE_PATTERN, STOP);
+      reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, COMPLEX_PATTERN, STOP);
+      reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, FORMAT_PATTERN, STOP);
+      reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, GENERAL_PATTERN, STOP);
+      reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, INTEGRAL_PATTERN, STOP);
+      reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, REAL_PATTERN, STOP);
+      reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, STRING_PATTERN, STOP);
+    }
+
+  /* Pictures.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, PICTURE, INSERTION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, PICTURE, A68_PATTERN, STOP);
+      reduce (q, NO_NOTE, NO_TICK, PICTURE, COLLECTION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, PICTURE, REPLICATOR, COLLECTION, STOP);
+    }
+
+  /* Picture lists.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (IS (q, PICTURE))
+	{
+	  bool siga = true;
+	  reduce (q, NO_NOTE, NO_TICK, PICTURE_LIST, PICTURE, STOP);
+	  while (siga)
+	    {
+	      siga = false;
+	      reduce (q, NO_NOTE, &siga, PICTURE_LIST, PICTURE_LIST, COMMA_SYMBOL, PICTURE, STOP);
+	      /* We filtered ambiguous patterns, so commas may be omitted  */
+	      reduce (q, NO_NOTE, &siga, PICTURE_LIST, PICTURE_LIST, PICTURE, STOP);
+	    }
+	}
+    }
+}
+
+/* Reduce secondaries completely.  */
+
+static void
+reduce_secondaries (NODE_T *p)
+{
+  NODE_T *q; bool siga;
+
+  for (q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, SECONDARY, PRIMARY, STOP);
+      reduce (q, NO_NOTE, NO_TICK, GENERATOR, LOC_SYMBOL, DECLARER, STOP);
+      reduce (q, NO_NOTE, NO_TICK, GENERATOR, HEAP_SYMBOL, DECLARER, STOP);
+      reduce (q, NO_NOTE, NO_TICK, SECONDARY, GENERATOR, STOP);
+    }
+  siga = true;
+  while (siga)
+    {
+      siga = false;
+      for (q = p; NEXT (q) != NO_NODE; FORWARD (q))
+	;
+      for (; q != NO_NODE; BACKWARD (q))
+	{
+	  reduce (q, NO_NOTE, &siga, SELECTION, SELECTOR, SECONDARY, STOP);
+	  reduce (q, NO_NOTE, &siga, SECONDARY, SELECTION, STOP);
+	}
+    }
+}
+
+/* Whether Q is an operator with priority K.  */
+
+static int
+operator_with_priority (NODE_T *q, int k)
+{
+  return NEXT (q) != NO_NODE
+    && ATTRIBUTE (NEXT (q)) == OPERATOR && PRIO (INFO (NEXT (q))) == k;
+}
+
+/* Reduce formulae.  */
+
+static void
+reduce_formulae (NODE_T * p)
+{
+  NODE_T *q = p;
+
+  while (q != NO_NODE)
+    {
+      if (a68_is_one_of (q, OPERATOR, SECONDARY, STOP))
+	q = reduce_dyadic (q, STOP);
+      else
+	FORWARD (q);
+    }
+
+  /* Reduce the expression.  */
+  for (int prio = MAX_PRIORITY; prio >= 0; prio--)
+    {
+      for (q = p; q != NO_NODE; FORWARD (q))
+	{
+	  if (operator_with_priority (q, prio))
+	    {
+	      bool siga = false;
+	      NODE_T *op = NEXT (q);
+	      if (IS (q, SECONDARY))
+		{
+		  reduce (q, NO_NOTE, &siga, FORMULA, SECONDARY, OPERATOR, SECONDARY, STOP);
+		  reduce (q, NO_NOTE, &siga, FORMULA, SECONDARY, OPERATOR, MONADIC_FORMULA, STOP);
+		  reduce (q, NO_NOTE, &siga, FORMULA, SECONDARY, OPERATOR, FORMULA, STOP);
+		}
+	      else if (IS (q, MONADIC_FORMULA))
+		{
+		  reduce (q, NO_NOTE, &siga, FORMULA, MONADIC_FORMULA, OPERATOR, SECONDARY, STOP);
+		  reduce (q, NO_NOTE, &siga, FORMULA, MONADIC_FORMULA, OPERATOR, MONADIC_FORMULA, STOP);
+		  reduce (q, NO_NOTE, &siga, FORMULA, MONADIC_FORMULA, OPERATOR, FORMULA, STOP);
+		}
+	      if (prio == 0 && siga)
+		a68_error (op, "S has no priority declaration");
+	      siga = true;
+	      while (siga)
+		{
+		  NODE_T *op2 = NEXT (q);
+		  siga = false;
+		  if (operator_with_priority (q, prio))
+		    reduce (q, NO_NOTE, &siga, FORMULA, FORMULA, OPERATOR, SECONDARY, STOP);
+		  if (operator_with_priority (q, prio))
+		    reduce (q, NO_NOTE, &siga, FORMULA, FORMULA, OPERATOR, MONADIC_FORMULA, STOP);
+		  if (operator_with_priority (q, prio))
+		    reduce (q, NO_NOTE, &siga, FORMULA, FORMULA, OPERATOR, FORMULA, STOP);
+		  if (prio == 0 && siga)
+		    a68_error (op2, "S has no priority declaration");
+		}
+	    }
+	}
+    }
+}
+
+/* Reduce dyadic expressions.  */
+
+static NODE_T *
+reduce_dyadic (NODE_T *p, int u)
+{
+  /* We work inside out - higher priority expressions get reduced first.  */
+  if (u > MAX_PRIORITY)
+    {
+      if (p == NO_NODE)
+	return NO_NODE;
+      else if (IS (p, OPERATOR))
+	{
+	  /* Reduce monadic formulas.  */
+	  NODE_T *q = p;
+	  bool siga;
+	  do
+	    {
+	      PRIO (INFO (q)) = 10;
+	      siga = ((NEXT (q) != NO_NODE) && (IS (NEXT (q), OPERATOR)));
+	      if (siga)
+		FORWARD (q);
+	    }
+	  while (siga);
+	  reduce (q, NO_NOTE, NO_TICK, MONADIC_FORMULA, OPERATOR, SECONDARY, STOP);
+	  while (q != p)
+	    {
+	      BACKWARD (q);
+	      reduce (q, NO_NOTE, NO_TICK, MONADIC_FORMULA, OPERATOR, MONADIC_FORMULA, STOP);
+	    }
+	}
+      FORWARD (p);
+    }
+  else
+    {
+      p = reduce_dyadic (p, u + 1);
+      while (p != NO_NODE && IS (p, OPERATOR) && PRIO (INFO (p)) == u)
+	{
+	  FORWARD (p);
+	  p = reduce_dyadic (p, u + 1);
+	}
+    }
+  return p;
+}
+
+/* Reduce tertiaries completely.  */
+
+static void
+reduce_tertiaries (NODE_T *p)
+{
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, TERTIARY, NIHIL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, FORMULA, MONADIC_FORMULA, STOP);
+      reduce (q, NO_NOTE, NO_TICK, TERTIARY, FORMULA, STOP);
+      reduce (q, NO_NOTE, NO_TICK, TERTIARY, SECONDARY, STOP);
+    }
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, IDENTITY_RELATION, TERTIARY, IS_SYMBOL, TERTIARY, STOP);
+      reduce (q, NO_NOTE, NO_TICK, IDENTITY_RELATION, TERTIARY, ISNT_SYMBOL, TERTIARY, STOP);
+    }
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, AND_FUNCTION, TERTIARY, ANDF_SYMBOL, TERTIARY, STOP);
+      reduce (q, NO_NOTE, NO_TICK, OR_FUNCTION, TERTIARY, ORF_SYMBOL, TERTIARY, STOP);
+    }
+}
+
+/* Reduce units. */
+
+static void
+reduce_units (NODE_T * p)
+{
+  /* Stray ~ is a SKIP.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (IS (q, OPERATOR) && IS_LITERALLY (q, "~"))
+	ATTRIBUTE (q) = SKIP;
+    }
+
+  /* Reduce units.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, UNIT, ASSIGNATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, UNIT, IDENTITY_RELATION, STOP);
+      reduce (q, a68_extension, NO_TICK, UNIT, AND_FUNCTION, STOP);
+      reduce (q, a68_extension, NO_TICK, UNIT, OR_FUNCTION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, UNIT, ROUTINE_TEXT, STOP);
+      reduce (q, NO_NOTE, NO_TICK, UNIT, JUMP, STOP);
+      reduce (q, NO_NOTE, NO_TICK, UNIT, SKIP, STOP);
+      reduce (q, NO_NOTE, NO_TICK, UNIT, TERTIARY, STOP);
+      reduce (q, NO_NOTE, NO_TICK, UNIT, ASSERTION, STOP);
+    }
+}
+
+/* Reduce_generic arguments.  */
+
+static void
+reduce_generic_arguments (NODE_T *p)
+{
+  NODE_T *q; bool siga; /* In this scope.  */
+
+  for (q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (IS (q, UNIT))
+	{
+	  reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, COLON_SYMBOL, UNIT, AT_SYMBOL, UNIT, STOP);
+	  reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, COLON_SYMBOL, UNIT, STOP);
+	  reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, COLON_SYMBOL, AT_SYMBOL, UNIT, STOP);
+	  reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, COLON_SYMBOL, STOP);
+	}
+      else if (IS (q, COLON_SYMBOL))
+	{
+	  reduce (q, NO_NOTE, NO_TICK, TRIMMER, COLON_SYMBOL, UNIT, AT_SYMBOL, UNIT, STOP);
+	  reduce (q, NO_NOTE, NO_TICK, TRIMMER, COLON_SYMBOL, UNIT, STOP);
+	  reduce (q, NO_NOTE, NO_TICK, TRIMMER, COLON_SYMBOL, AT_SYMBOL, UNIT, STOP);
+	  reduce (q, NO_NOTE, NO_TICK, TRIMMER, COLON_SYMBOL, STOP);
+	}
+    }
+
+  for (q = p; q != NO_NODE; FORWARD (q))
+    reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, AT_SYMBOL, UNIT, STOP);
+  for (q = p; q != NO_NODE; FORWARD (q))
+    reduce (q, NO_NOTE, NO_TICK, TRIMMER, AT_SYMBOL, UNIT, STOP);
+  for (q = p; q && NEXT (q); FORWARD (q))
+    {
+      if (IS (q, COMMA_SYMBOL))
+	{
+	  if (!(ATTRIBUTE (NEXT (q)) == UNIT || ATTRIBUTE (NEXT (q)) == TRIMMER))
+	    pad_node (q, TRIMMER);
+	}
+      else
+	{
+	  if (IS (NEXT (q), COMMA_SYMBOL))
+	    {
+	      if (!IS (q, UNIT) && !IS (q, TRIMMER))
+		pad_node (q, TRIMMER);
+	    }
+	}
+    }
+
+  q = NEXT (p);
+  if (q == NO_NODE)
+    gcc_unreachable ();
+  reduce (q, NO_NOTE, NO_TICK, GENERIC_ARGUMENT_LIST, UNIT, STOP);
+  reduce (q, NO_NOTE, NO_TICK, GENERIC_ARGUMENT_LIST, TRIMMER, STOP);
+  do
+    {
+      siga = false;
+      reduce (q, NO_NOTE, &siga, GENERIC_ARGUMENT_LIST, GENERIC_ARGUMENT_LIST, COMMA_SYMBOL, UNIT, STOP);
+      reduce (q, NO_NOTE, &siga, GENERIC_ARGUMENT_LIST, GENERIC_ARGUMENT_LIST, COMMA_SYMBOL, TRIMMER, STOP);
+      reduce (q, strange_separator, &siga, GENERIC_ARGUMENT_LIST, GENERIC_ARGUMENT_LIST, UNIT, STOP);
+      reduce (q, strange_separator, &siga, GENERIC_ARGUMENT_LIST, GENERIC_ARGUMENT_LIST, TRIMMER, STOP);
+    }
+  while (siga);
+}
+
+/* Reduce bounds.  */
+
+static void
+reduce_bounds (NODE_T *p)
+{
+  NODE_T *q; bool siga;
+
+  for (q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, BOUND, UNIT, COLON_SYMBOL, UNIT, STOP);
+      reduce (q, NO_NOTE, NO_TICK, BOUND, UNIT, STOP);
+    }
+  q = NEXT (p);
+  reduce (q, NO_NOTE, NO_TICK, BOUNDS_LIST, BOUND, STOP);
+  reduce (q, NO_NOTE, NO_TICK, FORMAL_BOUNDS_LIST, COMMA_SYMBOL, STOP);
+  reduce (q, NO_NOTE, NO_TICK, ALT_FORMAL_BOUNDS_LIST, COLON_SYMBOL, STOP);
+  do
+    {
+      siga = false;
+      reduce (q, NO_NOTE, &siga, BOUNDS_LIST, BOUNDS_LIST, COMMA_SYMBOL, BOUND, STOP);
+      reduce (q, NO_NOTE, &siga, FORMAL_BOUNDS_LIST, FORMAL_BOUNDS_LIST, COMMA_SYMBOL, STOP);
+      reduce (q, NO_NOTE, &siga, ALT_FORMAL_BOUNDS_LIST, FORMAL_BOUNDS_LIST, COLON_SYMBOL, STOP);
+      reduce (q, NO_NOTE, &siga, FORMAL_BOUNDS_LIST, ALT_FORMAL_BOUNDS_LIST, COMMA_SYMBOL, STOP);
+      reduce (q, strange_separator, &siga, BOUNDS_LIST, BOUNDS_LIST, BOUND, STOP);
+    }
+  while (siga);
+}
+
+/* Reduce argument packs.  */
+
+static void
+reduce_arguments (NODE_T *p)
+{
+  if (NEXT (p) != NO_NODE)
+    {
+      NODE_T *q = NEXT (p);
+      bool siga;
+      reduce (q, NO_NOTE, NO_TICK, ARGUMENT_LIST, UNIT, STOP);
+      do
+	{
+	  siga = false;
+	  reduce (q, NO_NOTE, &siga, ARGUMENT_LIST, ARGUMENT_LIST, COMMA_SYMBOL, UNIT, STOP);
+	  reduce (q, strange_separator, &siga, ARGUMENT_LIST, ARGUMENT_LIST, UNIT, STOP);
+	}
+      while (siga);
+    }
+}
+
+/* Reduce declarations.  */
+
+static void
+reduce_basic_declarations (NODE_T *p)
+{
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK,
+	      PRIORITY_DECLARATION, PRIO_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, PRIORITY, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      MODE_DECLARATION, MODE_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, DECLARER, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      MODE_DECLARATION, MODE_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, VOID_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      PROCEDURE_DECLARATION, PROC_SYMBOL, DEFINING_IDENTIFIER, EQUALS_SYMBOL, ROUTINE_TEXT, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      PROCEDURE_VARIABLE_DECLARATION, PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, ROUTINE_TEXT,
+	      STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      PROCEDURE_VARIABLE_DECLARATION, QUALIFIER, PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL,
+	      ROUTINE_TEXT, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      BRIEF_OPERATOR_DECLARATION, OP_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, ROUTINE_TEXT, STOP);
+      /* Errors.  */
+      reduce (q, strange_tokens, NO_TICK,
+	      PRIORITY_DECLARATION, PRIO_SYMBOL, -DEFINING_OPERATOR, -EQUALS_SYMBOL, -PRIORITY, STOP);
+      reduce (q, strange_tokens, NO_TICK,
+	      MODE_DECLARATION, MODE_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, -DECLARER, STOP);
+      reduce (q, strange_tokens, NO_TICK,
+	      PROCEDURE_DECLARATION, PROC_SYMBOL, DEFINING_IDENTIFIER, EQUALS_SYMBOL, -ROUTINE_TEXT, STOP);
+      reduce (q, strange_tokens, NO_TICK,
+	      PROCEDURE_VARIABLE_DECLARATION, PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, -ROUTINE_TEXT,
+	      STOP);
+      reduce (q, strange_tokens, NO_TICK,
+	      PROCEDURE_VARIABLE_DECLARATION, QUALIFIER, PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL,
+	      -ROUTINE_TEXT, STOP);
+      reduce (q, strange_tokens, NO_TICK,
+	      BRIEF_OPERATOR_DECLARATION, OP_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, -ROUTINE_TEXT, STOP);
+      /* Errors. WILDCARD catches TERTIARY which catches IDENTIFIER.  */
+      reduce (q, strange_tokens, NO_TICK, PROCEDURE_DECLARATION, PROC_SYMBOL, WILDCARD, ROUTINE_TEXT, STOP);
+    }
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      bool siga;
+      do
+	{
+	  siga = false;
+	  reduce (q, NO_NOTE, &siga,
+		  PRIORITY_DECLARATION, PRIORITY_DECLARATION, COMMA_SYMBOL, DEFINING_OPERATOR,
+		  EQUALS_SYMBOL, PRIORITY, STOP);
+	  reduce (q, NO_NOTE, &siga,
+		  MODE_DECLARATION, MODE_DECLARATION, COMMA_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL,
+		  DECLARER, STOP);
+	  reduce (q, NO_NOTE, &siga,
+		  MODE_DECLARATION, MODE_DECLARATION, COMMA_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL,
+		  VOID_SYMBOL, STOP);
+	  reduce (q, NO_NOTE, &siga,
+		  PROCEDURE_DECLARATION, PROCEDURE_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER,
+		  EQUALS_SYMBOL, ROUTINE_TEXT, STOP);
+	  reduce (q, NO_NOTE, &siga,
+		  PROCEDURE_VARIABLE_DECLARATION, PROCEDURE_VARIABLE_DECLARATION, COMMA_SYMBOL,
+		  DEFINING_IDENTIFIER, ASSIGN_SYMBOL, ROUTINE_TEXT, STOP);
+	  reduce (q, NO_NOTE, &siga,
+		  BRIEF_OPERATOR_DECLARATION, BRIEF_OPERATOR_DECLARATION, COMMA_SYMBOL,
+		  DEFINING_OPERATOR, EQUALS_SYMBOL, ROUTINE_TEXT, STOP);
+	  /* Errors. WILDCARD catches TERTIARY which catches IDENTIFIER.  */
+	  reduce (q, strange_tokens, &siga,
+		  PROCEDURE_DECLARATION, PROCEDURE_DECLARATION, COMMA_SYMBOL, WILDCARD, ROUTINE_TEXT, STOP);
+	}
+      while (siga);
+    }
+}
+
+/* Reduce declaration lists.  */
+
+static void
+reduce_declaration_lists (NODE_T *p)
+{
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK,
+	      IDENTITY_DECLARATION, DECLARER, DEFINING_IDENTIFIER, EQUALS_SYMBOL, UNIT, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      VARIABLE_DECLARATION, QUALIFIER, DECLARER, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      VARIABLE_DECLARATION, QUALIFIER, DECLARER, DEFINING_IDENTIFIER, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      VARIABLE_DECLARATION, DECLARER, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP);
+      reduce (q, NO_NOTE, NO_TICK,
+	      VARIABLE_DECLARATION, DECLARER, DEFINING_IDENTIFIER, STOP);
+    }
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      bool siga;
+      do
+	{
+	  siga = false;
+	  reduce (q, NO_NOTE, &siga,
+		  IDENTITY_DECLARATION, IDENTITY_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER,
+		  EQUALS_SYMBOL, UNIT, STOP);
+	  reduce (q, NO_NOTE, &siga,
+		  VARIABLE_DECLARATION, VARIABLE_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER,
+		  ASSIGN_SYMBOL, UNIT, STOP);
+	  if (!a68_whether (q, VARIABLE_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER,
+			    ASSIGN_SYMBOL, UNIT, STOP))
+	    reduce (q, NO_NOTE, &siga,
+		    VARIABLE_DECLARATION, VARIABLE_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER, STOP);
+	}
+      while (siga);
+    }
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK,
+	      OPERATOR_DECLARATION, OPERATOR_PLAN, DEFINING_OPERATOR, EQUALS_SYMBOL, UNIT, STOP);
+    }
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      bool siga;
+      do
+	{
+	  siga = false;
+	  reduce (q, NO_NOTE, &siga,
+		  OPERATOR_DECLARATION, OPERATOR_DECLARATION, COMMA_SYMBOL, DEFINING_OPERATOR,
+		  EQUALS_SYMBOL, UNIT, STOP);
+	}
+      while (siga);
+    }
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, MODE_DECLARATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, PRIORITY_DECLARATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, BRIEF_OPERATOR_DECLARATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, OPERATOR_DECLARATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, IDENTITY_DECLARATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, PROCEDURE_DECLARATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, PROCEDURE_VARIABLE_DECLARATION, STOP);
+      reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, VARIABLE_DECLARATION, STOP);
+    }
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      bool siga;
+      do
+	{
+	  siga = false;
+	  reduce (q, NO_NOTE, &siga,
+		  DECLARATION_LIST, DECLARATION_LIST, COMMA_SYMBOL, DECLARATION_LIST, STOP);
+	}
+      while (siga);
+    }
+}
+
+/* Reduce serial clauses.  */
+
+static void
+reduce_serial_clauses (NODE_T *p)
+{
+  if (NEXT (p) != NO_NODE)
+    {
+      NODE_T *q = NEXT (p), *u;
+      bool siga, label_seen;
+      /* Check wrong exits.  */
+      for (u = q; u != NO_NODE; FORWARD (u))
+	{
+	  if (IS (u, EXIT_SYMBOL))
+	    {
+	      if (NEXT (u) == NO_NODE || !IS (NEXT (u), LABELED_UNIT))
+		a68_error (u, "S must be followed by a labeled unit");
+	    }
+	}
+
+      /* Check wrong jumps and declarations.  */
+      for (u = q, label_seen = false; u != NO_NODE; FORWARD (u))
+	{
+	  if (IS (u, LABELED_UNIT))
+	    label_seen = true;
+	  else if (IS (u, DECLARATION_LIST))
+	    {
+	      if (label_seen)
+		a68_error (u, "declaration cannot follow a labeled unit");
+	    }
+	}
+
+      /* Reduce serial clauses.  */
+      reduce (q, NO_NOTE, NO_TICK, SERIAL_CLAUSE, LABELED_UNIT, STOP);
+      reduce (q, NO_NOTE, NO_TICK, SERIAL_CLAUSE, UNIT, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INITIALISER_SERIES, DECLARATION_LIST, STOP);
+      do
+	{
+	  siga = false;
+	  if (IS (q, SERIAL_CLAUSE))
+	    {
+	      reduce (q, NO_NOTE, &siga,
+		      SERIAL_CLAUSE, SERIAL_CLAUSE, SEMI_SYMBOL, UNIT, STOP);
+	      reduce (q, NO_NOTE, &siga,
+		      SERIAL_CLAUSE, SERIAL_CLAUSE, EXIT_SYMBOL, LABELED_UNIT, STOP);
+	      reduce (q, NO_NOTE, &siga,
+		      SERIAL_CLAUSE, SERIAL_CLAUSE, SEMI_SYMBOL, LABELED_UNIT, STOP);
+	      reduce (q, NO_NOTE, &siga,
+		      INITIALISER_SERIES, SERIAL_CLAUSE, SEMI_SYMBOL, DECLARATION_LIST, STOP);
+	      /* Errors  */
+	      reduce (q, strange_separator, &siga,
+		      SERIAL_CLAUSE, SERIAL_CLAUSE, COMMA_SYMBOL, UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      SERIAL_CLAUSE, SERIAL_CLAUSE, COMMA_SYMBOL, LABELED_UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      INITIALISER_SERIES, SERIAL_CLAUSE, COMMA_SYMBOL, DECLARATION_LIST, STOP);
+	      reduce (q, strange_separator, &siga,
+		      SERIAL_CLAUSE, SERIAL_CLAUSE, COLON_SYMBOL, UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      SERIAL_CLAUSE, SERIAL_CLAUSE, COLON_SYMBOL, LABELED_UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      INITIALISER_SERIES, SERIAL_CLAUSE, COLON_SYMBOL, DECLARATION_LIST, STOP);
+	      reduce (q, strange_separator, &siga,
+		      SERIAL_CLAUSE, SERIAL_CLAUSE, UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      SERIAL_CLAUSE, SERIAL_CLAUSE, LABELED_UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      INITIALISER_SERIES, SERIAL_CLAUSE, DECLARATION_LIST, STOP);
+	    }
+	  else if (IS (q, INITIALISER_SERIES))
+	    {
+	      reduce (q, NO_NOTE, &siga,
+		      SERIAL_CLAUSE, INITIALISER_SERIES, SEMI_SYMBOL, UNIT, STOP);
+	      reduce (q, NO_NOTE, &siga,
+		      SERIAL_CLAUSE, INITIALISER_SERIES, SEMI_SYMBOL, LABELED_UNIT, STOP);
+	      reduce (q, NO_NOTE, &siga,
+		      INITIALISER_SERIES, INITIALISER_SERIES, SEMI_SYMBOL, DECLARATION_LIST, STOP);
+	      /* Errors  */
+	      reduce (q, strange_separator, &siga,
+		      SERIAL_CLAUSE, INITIALISER_SERIES, COMMA_SYMBOL, UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      SERIAL_CLAUSE, INITIALISER_SERIES, COMMA_SYMBOL, LABELED_UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      INITIALISER_SERIES, INITIALISER_SERIES, COMMA_SYMBOL, DECLARATION_LIST, STOP);
+	      reduce (q, strange_separator, &siga,
+		      SERIAL_CLAUSE, INITIALISER_SERIES, COLON_SYMBOL, UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      SERIAL_CLAUSE, INITIALISER_SERIES, COLON_SYMBOL, LABELED_UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      INITIALISER_SERIES, INITIALISER_SERIES, COLON_SYMBOL, DECLARATION_LIST, STOP);
+	      reduce (q, strange_separator, &siga,
+		      SERIAL_CLAUSE, INITIALISER_SERIES, UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      SERIAL_CLAUSE, INITIALISER_SERIES, LABELED_UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      INITIALISER_SERIES, INITIALISER_SERIES, DECLARATION_LIST, STOP);
+	    }
+	}
+      while (siga);
+    }
+}
+
+/* Reduce enquiry clauses.  */
+
+static void
+reduce_enquiry_clauses (NODE_T *p)
+{
+  if (NEXT (p) != NO_NODE)
+    {
+      NODE_T *q = NEXT (p);
+      bool siga;
+      reduce (q, NO_NOTE, NO_TICK, ENQUIRY_CLAUSE, UNIT, STOP);
+      reduce (q, NO_NOTE, NO_TICK, INITIALISER_SERIES, DECLARATION_LIST, STOP);
+      do
+	{
+	  siga = false;
+	  if (IS (q, ENQUIRY_CLAUSE))
+	    {
+	      reduce (q, NO_NOTE, &siga,
+		      ENQUIRY_CLAUSE, ENQUIRY_CLAUSE, SEMI_SYMBOL, UNIT, STOP);
+	      reduce (q, NO_NOTE, &siga,
+		      INITIALISER_SERIES, ENQUIRY_CLAUSE, SEMI_SYMBOL, DECLARATION_LIST, STOP);
+	      reduce (q, strange_separator, &siga,
+		      ENQUIRY_CLAUSE, ENQUIRY_CLAUSE, COMMA_SYMBOL, UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      INITIALISER_SERIES, ENQUIRY_CLAUSE, COMMA_SYMBOL, DECLARATION_LIST, STOP);
+	      reduce (q, strange_separator, &siga,
+		      ENQUIRY_CLAUSE, ENQUIRY_CLAUSE, COLON_SYMBOL, UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      INITIALISER_SERIES, ENQUIRY_CLAUSE, COLON_SYMBOL, DECLARATION_LIST, STOP);
+	      reduce (q, strange_separator, &siga,
+		      ENQUIRY_CLAUSE, ENQUIRY_CLAUSE, UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      INITIALISER_SERIES, ENQUIRY_CLAUSE, DECLARATION_LIST, STOP);
+	    }
+	  else if (IS (q, INITIALISER_SERIES))
+	    {
+	      reduce (q, NO_NOTE, &siga,
+		      ENQUIRY_CLAUSE, INITIALISER_SERIES, SEMI_SYMBOL, UNIT, STOP);
+	      reduce (q, NO_NOTE, &siga,
+		      INITIALISER_SERIES, INITIALISER_SERIES, SEMI_SYMBOL, DECLARATION_LIST, STOP);
+	      reduce (q, strange_separator, &siga,
+		      ENQUIRY_CLAUSE, INITIALISER_SERIES, COMMA_SYMBOL, UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      INITIALISER_SERIES, INITIALISER_SERIES, COMMA_SYMBOL, DECLARATION_LIST, STOP);
+	      reduce (q, strange_separator, &siga,
+		      ENQUIRY_CLAUSE, INITIALISER_SERIES, COLON_SYMBOL, UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      INITIALISER_SERIES, INITIALISER_SERIES, COLON_SYMBOL, DECLARATION_LIST, STOP);
+	      reduce (q, strange_separator, &siga,
+		      ENQUIRY_CLAUSE, INITIALISER_SERIES, UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      INITIALISER_SERIES, INITIALISER_SERIES, DECLARATION_LIST, STOP);
+	    }
+	}
+      while (siga);
+    }
+}
+
+/* Reduce collateral clauses.  */
+
+static void
+reduce_collateral_clauses (NODE_T *p)
+{
+  if (NEXT (p) != NO_NODE)
+    {
+      NODE_T *q = NEXT (p);
+      if (IS (q, UNIT))
+	{
+	  bool siga;
+	  reduce (q, NO_NOTE, NO_TICK, UNIT_LIST, UNIT, STOP);
+	  do
+	    {
+	      siga = false;
+	      reduce (q, NO_NOTE, &siga, UNIT_LIST, UNIT_LIST, COMMA_SYMBOL, UNIT, STOP);
+	      reduce (q, strange_separator, &siga, UNIT_LIST, UNIT_LIST, UNIT, STOP);
+	    }
+	  while (siga);
+	}
+      else if (IS (q, SPECIFIED_UNIT))
+	{
+	  bool siga;
+	  reduce (q, NO_NOTE, NO_TICK, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT, STOP);
+	  do
+	    {
+	      siga = false;
+	      reduce (q, NO_NOTE, &siga,
+		      SPECIFIED_UNIT_LIST, SPECIFIED_UNIT_LIST, COMMA_SYMBOL, SPECIFIED_UNIT, STOP);
+	      reduce (q, strange_separator, &siga,
+		      SPECIFIED_UNIT_LIST, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT, STOP);
+	    }
+	  while (siga);
+	}
+    }
+}
+
+/* Reduces enclosed clauses.  */
+
+static void
+reduce_enclosed_clauses (NODE_T *q, enum a68_attribute expect)
+{
+  NODE_T *p = q;
+
+  if (SUB (p) == NO_NODE)
+    {
+      if (IS (p, FOR_SYMBOL))
+	reduce (p, NO_NOTE, NO_TICK, FOR_PART, FOR_SYMBOL, DEFINING_IDENTIFIER, STOP);
+      else if (IS (p, OPEN_SYMBOL))
+	{
+	  if (expect == ENQUIRY_CLAUSE)
+	    reduce (p, NO_NOTE, NO_TICK, OPEN_PART, OPEN_SYMBOL, ENQUIRY_CLAUSE, STOP);
+	  else if (expect == ARGUMENT)
+	    {
+	      reduce (p, NO_NOTE, NO_TICK, ARGUMENT, OPEN_SYMBOL, CLOSE_SYMBOL, STOP);
+	      reduce (p, NO_NOTE, NO_TICK, ARGUMENT, OPEN_SYMBOL, ARGUMENT_LIST, CLOSE_SYMBOL, STOP);
+	      reduce (p, empty_clause, NO_TICK, ARGUMENT, OPEN_SYMBOL, INITIALISER_SERIES, CLOSE_SYMBOL, STOP);
+	    }
+	  else if (expect == GENERIC_ARGUMENT)
+	    {
+	      if (a68_whether (p, OPEN_SYMBOL, CLOSE_SYMBOL, STOP))
+		{
+		  pad_node (p, TRIMMER);
+		  reduce (p, NO_NOTE, NO_TICK, GENERIC_ARGUMENT, OPEN_SYMBOL, TRIMMER, CLOSE_SYMBOL, STOP);
+		}
+	      reduce (p, NO_NOTE, NO_TICK,
+		      GENERIC_ARGUMENT, OPEN_SYMBOL, GENERIC_ARGUMENT_LIST, CLOSE_SYMBOL, STOP);
+	    }
+	  else if (expect == BOUNDS)
+	    {
+	      reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, OPEN_SYMBOL, CLOSE_SYMBOL, STOP);
+	      reduce (p, NO_NOTE, NO_TICK, BOUNDS, OPEN_SYMBOL, BOUNDS_LIST, CLOSE_SYMBOL, STOP);
+	      reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, OPEN_SYMBOL, FORMAL_BOUNDS_LIST, CLOSE_SYMBOL, STOP);
+	      reduce (p, NO_NOTE, NO_TICK,
+		      FORMAL_BOUNDS, OPEN_SYMBOL, ALT_FORMAL_BOUNDS_LIST, CLOSE_SYMBOL, STOP);
+	    }
+	  else
+	    {
+	      reduce (p, NO_NOTE, NO_TICK, CLOSED_CLAUSE, OPEN_SYMBOL, SERIAL_CLAUSE, CLOSE_SYMBOL, STOP);
+	      reduce (p, NO_NOTE, NO_TICK, COLLATERAL_CLAUSE, OPEN_SYMBOL, UNIT_LIST, CLOSE_SYMBOL, STOP);
+	      reduce (p, NO_NOTE, NO_TICK, COLLATERAL_CLAUSE, OPEN_SYMBOL, CLOSE_SYMBOL, STOP);
+	      reduce (p, empty_clause, NO_TICK,
+		      CLOSED_CLAUSE, OPEN_SYMBOL, INITIALISER_SERIES, CLOSE_SYMBOL, STOP);
+	    }
+	}
+      else if (IS (p, SUB_SYMBOL))
+	{
+	  if (expect == GENERIC_ARGUMENT)
+	    {
+	      if (a68_whether (p, SUB_SYMBOL, BUS_SYMBOL, STOP))
+		{
+		  pad_node (p, TRIMMER);
+		  reduce (p, NO_NOTE, NO_TICK, GENERIC_ARGUMENT, SUB_SYMBOL, TRIMMER, BUS_SYMBOL, STOP);
+		}
+	      reduce (p, NO_NOTE, NO_TICK,
+		      GENERIC_ARGUMENT, SUB_SYMBOL, GENERIC_ARGUMENT_LIST, BUS_SYMBOL, STOP);
+	    }
+	  else if (expect == BOUNDS)
+	    {
+	      reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, SUB_SYMBOL, BUS_SYMBOL, STOP);
+	      reduce (p, NO_NOTE, NO_TICK, BOUNDS, SUB_SYMBOL, BOUNDS_LIST, BUS_SYMBOL, STOP);
+	      reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, SUB_SYMBOL, FORMAL_BOUNDS_LIST, BUS_SYMBOL, STOP);
+	      reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, SUB_SYMBOL, ALT_FORMAL_BOUNDS_LIST, BUS_SYMBOL, STOP);
+	    }
+	}
+      else if (IS (p, BEGIN_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, COLLATERAL_CLAUSE, BEGIN_SYMBOL, UNIT_LIST, END_SYMBOL, STOP);
+	  reduce (p, NO_NOTE, NO_TICK, COLLATERAL_CLAUSE, BEGIN_SYMBOL, END_SYMBOL, STOP);
+	  reduce (p, NO_NOTE, NO_TICK, CLOSED_CLAUSE, BEGIN_SYMBOL, SERIAL_CLAUSE, END_SYMBOL, STOP);
+	  reduce (p, empty_clause, NO_TICK, CLOSED_CLAUSE, BEGIN_SYMBOL, INITIALISER_SERIES, END_SYMBOL, STOP);
+	}
+      else if (IS (p, FORMAT_DELIMITER_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK,
+		  FORMAT_TEXT, FORMAT_DELIMITER_SYMBOL, PICTURE_LIST, FORMAT_DELIMITER_SYMBOL, STOP);
+	  reduce (p, NO_NOTE, NO_TICK,
+		  FORMAT_TEXT, FORMAT_DELIMITER_SYMBOL, FORMAT_DELIMITER_SYMBOL, STOP);
+	}
+      else if (IS (p, FORMAT_OPEN_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK,
+		  COLLECTION, FORMAT_OPEN_SYMBOL, PICTURE_LIST, FORMAT_CLOSE_SYMBOL, STOP);
+	}
+      else if (IS (p, IF_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, IF_PART, IF_SYMBOL, ENQUIRY_CLAUSE, STOP);
+	  reduce (p, empty_clause, NO_TICK, IF_PART, IF_SYMBOL, INITIALISER_SERIES, STOP);
+	}
+      else if (IS (p, THEN_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, THEN_PART, THEN_SYMBOL, SERIAL_CLAUSE, STOP);
+	  reduce (p, empty_clause, NO_TICK, THEN_PART, THEN_SYMBOL, INITIALISER_SERIES, STOP);
+	}
+      else if (IS (p, ELSE_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, ELSE_PART, ELSE_SYMBOL, SERIAL_CLAUSE, STOP);
+	  reduce (p, empty_clause, NO_TICK, ELSE_PART, ELSE_SYMBOL, INITIALISER_SERIES, STOP);
+	}
+      else if (IS (p, ELIF_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, ELIF_IF_PART, ELIF_SYMBOL, ENQUIRY_CLAUSE, STOP);
+	}
+      else if (IS (p, CASE_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, CASE_PART, CASE_SYMBOL, ENQUIRY_CLAUSE, STOP);
+	  reduce (p, empty_clause, NO_TICK, CASE_PART, CASE_SYMBOL, INITIALISER_SERIES, STOP);
+	}
+      else if (IS (p, IN_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, CASE_IN_PART, IN_SYMBOL, UNIT_LIST, STOP);
+	  reduce (p, NO_NOTE, NO_TICK, CONFORMITY_IN_PART, IN_SYMBOL, SPECIFIED_UNIT_LIST, STOP);
+	}
+      else if (IS (p, OUT_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, OUT_PART, OUT_SYMBOL, SERIAL_CLAUSE, STOP);
+	  reduce (p, empty_clause, NO_TICK, OUT_PART, OUT_SYMBOL, INITIALISER_SERIES, STOP);
+	}
+      else if (IS (p, OUSE_SYMBOL))
+	reduce (p, NO_NOTE, NO_TICK, OUSE_PART, OUSE_SYMBOL, ENQUIRY_CLAUSE, STOP);
+      else if (IS (p, THEN_BAR_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, CHOICE, THEN_BAR_SYMBOL, SERIAL_CLAUSE, STOP);
+	  reduce (p, NO_NOTE, NO_TICK, CASE_CHOICE_CLAUSE, THEN_BAR_SYMBOL, UNIT_LIST, STOP);
+	  reduce (p, NO_NOTE, NO_TICK, CONFORMITY_CHOICE, THEN_BAR_SYMBOL, SPECIFIED_UNIT_LIST, STOP);
+	  reduce (p, NO_NOTE, NO_TICK, CONFORMITY_CHOICE, THEN_BAR_SYMBOL, SPECIFIED_UNIT, STOP);
+	  reduce (p, empty_clause, NO_TICK, CHOICE, THEN_BAR_SYMBOL, INITIALISER_SERIES, STOP);
+	}
+      else if (IS (p, ELSE_BAR_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, ELSE_OPEN_PART, ELSE_BAR_SYMBOL, ENQUIRY_CLAUSE, STOP);
+	  reduce (p, empty_clause, NO_TICK, ELSE_OPEN_PART, ELSE_BAR_SYMBOL, INITIALISER_SERIES, STOP);
+	}
+      else if (IS (p, FROM_SYMBOL))
+	reduce (p, NO_NOTE, NO_TICK, FROM_PART, FROM_SYMBOL, UNIT, STOP);
+      else if (IS (p, BY_SYMBOL))
+	reduce (p, NO_NOTE, NO_TICK, BY_PART, BY_SYMBOL, UNIT, STOP);
+      else if (IS (p, TO_SYMBOL))
+	reduce (p, NO_NOTE, NO_TICK, TO_PART, TO_SYMBOL, UNIT, STOP);
+      else if (IS (p, WHILE_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, WHILE_PART, WHILE_SYMBOL, ENQUIRY_CLAUSE, STOP);
+	  reduce (p, empty_clause, NO_TICK, WHILE_PART, WHILE_SYMBOL, INITIALISER_SERIES, STOP);
+	}
+      else if (IS (p, DO_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, DO_PART, DO_SYMBOL, SERIAL_CLAUSE, OD_SYMBOL, STOP);
+	}
+      else if (IS (p, ALT_DO_SYMBOL))
+	{
+	  reduce (p, NO_NOTE, NO_TICK, ALT_DO_PART, ALT_DO_SYMBOL, SERIAL_CLAUSE, OD_SYMBOL, STOP);
+	}
+    }
+  p = q;
+  if (SUB (p) != NO_NODE)
+    {
+    if (IS (p, OPEN_PART))
+      {
+	reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, OPEN_PART, CHOICE, CHOICE, CLOSE_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, OPEN_PART, CHOICE, CLOSE_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, OPEN_PART, CHOICE, BRIEF_ELIF_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, OPEN_PART, CASE_CHOICE_CLAUSE, CHOICE, CLOSE_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, OPEN_PART, CASE_CHOICE_CLAUSE, CLOSE_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, OPEN_PART, CASE_CHOICE_CLAUSE, BRIEF_OUSE_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		CONFORMITY_CLAUSE, OPEN_PART, CONFORMITY_CHOICE, CHOICE, CLOSE_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		CONFORMITY_CLAUSE, OPEN_PART, CONFORMITY_CHOICE, CLOSE_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		CONFORMITY_CLAUSE, OPEN_PART, CONFORMITY_CHOICE, BRIEF_CONFORMITY_OUSE_PART, STOP);
+      }
+    else if (IS (p, ELSE_OPEN_PART))
+      {
+	reduce (p, NO_NOTE, NO_TICK, BRIEF_ELIF_PART, ELSE_OPEN_PART, CHOICE, CHOICE, CLOSE_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, BRIEF_ELIF_PART, ELSE_OPEN_PART, CHOICE, CLOSE_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, BRIEF_ELIF_PART, ELSE_OPEN_PART, CHOICE, BRIEF_ELIF_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		BRIEF_OUSE_PART, ELSE_OPEN_PART, CASE_CHOICE_CLAUSE, CHOICE, CLOSE_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, BRIEF_OUSE_PART, ELSE_OPEN_PART, CASE_CHOICE_CLAUSE, CLOSE_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		BRIEF_OUSE_PART, ELSE_OPEN_PART, CASE_CHOICE_CLAUSE, BRIEF_OUSE_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		BRIEF_CONFORMITY_OUSE_PART, ELSE_OPEN_PART, CONFORMITY_CHOICE, CHOICE, CLOSE_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		BRIEF_CONFORMITY_OUSE_PART, ELSE_OPEN_PART, CONFORMITY_CHOICE, CLOSE_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		BRIEF_CONFORMITY_OUSE_PART, ELSE_OPEN_PART, CONFORMITY_CHOICE, BRIEF_CONFORMITY_OUSE_PART,
+		STOP);
+      }
+    else if (IS (p, IF_PART))
+      {
+	reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, IF_PART, THEN_PART, ELSE_PART, FI_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, IF_PART, THEN_PART, ELIF_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, IF_PART, THEN_PART, FI_SYMBOL, STOP);
+      }
+    else if (IS (p, ELIF_IF_PART))
+      {
+	reduce (p, NO_NOTE, NO_TICK, ELIF_PART, ELIF_IF_PART, THEN_PART, ELSE_PART, FI_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, ELIF_PART, ELIF_IF_PART, THEN_PART, FI_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, ELIF_PART, ELIF_IF_PART, THEN_PART, ELIF_PART, STOP);
+      }
+    else if (IS (p, CASE_PART))
+      {
+	reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, CASE_PART, CASE_IN_PART, OUT_PART, ESAC_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, CASE_PART, CASE_IN_PART, ESAC_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, CASE_PART, CASE_IN_PART, CASE_OUSE_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		CONFORMITY_CLAUSE, CASE_PART, CONFORMITY_IN_PART, OUT_PART, ESAC_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		CONFORMITY_CLAUSE, CASE_PART, CONFORMITY_IN_PART, ESAC_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		CONFORMITY_CLAUSE, CASE_PART, CONFORMITY_IN_PART, CONFORMITY_OUSE_PART, STOP);
+      }
+    else if (IS (p, OUSE_PART))
+      {
+	reduce (p, NO_NOTE, NO_TICK, CASE_OUSE_PART, OUSE_PART, CASE_IN_PART, OUT_PART, ESAC_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, CASE_OUSE_PART, OUSE_PART, CASE_IN_PART, ESAC_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK, CASE_OUSE_PART, OUSE_PART, CASE_IN_PART, CASE_OUSE_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		CONFORMITY_OUSE_PART, OUSE_PART, CONFORMITY_IN_PART, OUT_PART, ESAC_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		CONFORMITY_OUSE_PART, OUSE_PART, CONFORMITY_IN_PART, ESAC_SYMBOL, STOP);
+	reduce (p, NO_NOTE, NO_TICK,
+		CONFORMITY_OUSE_PART, OUSE_PART, CONFORMITY_IN_PART, CONFORMITY_OUSE_PART, STOP);
+      }
+    else if (IS (p, FOR_PART))
+      {
+	reduce (p, NO_NOTE, NO_TICK,
+		LOOP_CLAUSE, FOR_PART, FROM_PART, BY_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, BY_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, BY_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, BY_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, BY_PART, TO_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, BY_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, TO_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, BY_PART, TO_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, BY_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, TO_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, ALT_DO_PART, STOP);
+      }
+    else if (IS (p, FROM_PART))
+      {
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, BY_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, BY_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, BY_PART, TO_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, BY_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, TO_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, ALT_DO_PART, STOP);
+      }
+    else if (IS (p, BY_PART))
+      {
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, BY_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, BY_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, BY_PART, TO_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, BY_PART, ALT_DO_PART, STOP);
+      }
+    else if (IS (p, TO_PART))
+      {
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, TO_PART, WHILE_PART, ALT_DO_PART, STOP);
+	reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, TO_PART, ALT_DO_PART, STOP);
+      }
+    else if (IS (p, WHILE_PART))
+      reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, WHILE_PART, ALT_DO_PART, STOP);
+    else if (IS (p, DO_PART))
+      reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, DO_PART, STOP);
+    }
+}
+
+/* Substitute reduction when a phrase could not be parsed.  */
+
+static void
+recover_from_error (NODE_T * p, enum a68_attribute expect, bool suppress)
+{
+  /* This routine does not do fancy things as that might introduce more
+     errors.  */
+  NODE_T *q = p;
+  if (p == NO_NODE)
+    return;
+
+  if (expect == SOME_CLAUSE)
+    expect = serial_or_collateral (p);
+
+  if (!suppress)
+    {
+      /* Give an error message.  */
+      NODE_T *w = p;
+      char *seq = a68_phrase_to_text (p, &w);
+      if (strlen (seq) == 0)
+	{
+	  if (ERROR_COUNT (&A68_JOB) == 0)
+	    a68_error (w, "expected A", expect);
+	}
+      else
+	a68_error (w, "Y is an invalid A", seq, expect);
+
+    if (ERROR_COUNT (&A68_JOB) >= MAX_ERRORS)
+      longjmp (A68_PARSER (bottom_up_crash_exit), 1);
+  }
+
+  /* Try to prevent spurious diagnostics by guessing what was expected.  */
+  while (NEXT (q) != NO_NODE)
+    FORWARD (q);
+
+  if (a68_is_one_of (p, BEGIN_SYMBOL, OPEN_SYMBOL, STOP))
+    {
+      if (expect == ARGUMENT || expect == COLLATERAL_CLAUSE
+	  || expect == PARAMETER_PACK || expect == STRUCTURE_PACK
+	  || expect == UNION_PACK)
+	a68_make_sub (p, q, expect);
+      else if (expect == ENQUIRY_CLAUSE)
+	a68_make_sub (p, q, OPEN_PART);
+      else if (expect == FORMAL_DECLARERS)
+	a68_make_sub (p, q, FORMAL_DECLARERS);
+      else
+	a68_make_sub (p, q, CLOSED_CLAUSE);
+    }
+  else if (IS (p, FORMAT_DELIMITER_SYMBOL) && expect == FORMAT_TEXT)
+    a68_make_sub (p, q, FORMAT_TEXT);
+  else if (a68_is_one_of (p, THEN_BAR_SYMBOL, CHOICE, STOP))
+    a68_make_sub (p, q, CHOICE);
+  else if (a68_is_one_of (p, IF_SYMBOL, IF_PART, STOP))
+    a68_make_sub (p, q, IF_PART);
+  else if (a68_is_one_of (p, THEN_SYMBOL, THEN_PART, STOP))
+    a68_make_sub (p, q, THEN_PART);
+  else if (a68_is_one_of (p, ELSE_SYMBOL, ELSE_PART, STOP))
+    a68_make_sub (p, q, ELSE_PART);
+  else if (a68_is_one_of (p, ELIF_SYMBOL, ELIF_IF_PART, STOP))
+    a68_make_sub (p, q, ELIF_IF_PART);
+  else if (a68_is_one_of (p, CASE_SYMBOL, CASE_PART, STOP))
+    a68_make_sub (p, q, CASE_PART);
+  else if (a68_is_one_of (p, OUT_SYMBOL, OUT_PART, STOP))
+    a68_make_sub (p, q, OUT_PART);
+  else if (a68_is_one_of (p, OUSE_SYMBOL, OUSE_PART, STOP))
+    a68_make_sub (p, q, OUSE_PART);
+  else if (a68_is_one_of (p, FOR_SYMBOL, FOR_PART, STOP))
+    a68_make_sub (p, q, FOR_PART);
+  else if (a68_is_one_of (p, FROM_SYMBOL, FROM_PART, STOP))
+    a68_make_sub (p, q, FROM_PART);
+  else if (a68_is_one_of (p, BY_SYMBOL, BY_PART, STOP))
+    a68_make_sub (p, q, BY_PART);
+  else if (a68_is_one_of (p, TO_SYMBOL, TO_PART, STOP))
+    a68_make_sub (p, q, TO_PART);
+  else if (a68_is_one_of (p, WHILE_SYMBOL, WHILE_PART, STOP))
+    a68_make_sub (p, q, WHILE_PART);
+  else if (a68_is_one_of (p, DO_SYMBOL, DO_PART, STOP))
+    a68_make_sub (p, q, DO_PART);
+  else if (a68_is_one_of (p, ALT_DO_SYMBOL, ALT_DO_PART, STOP))
+    a68_make_sub (p, q, ALT_DO_PART);
+  else if (a68_attribute_name (expect) != NO_TEXT)
+    a68_make_sub (p, q, expect);
+}
+
+/* Heuristic aid in pinpointing errors.  */
+
+static void
+reduce_erroneous_units (NODE_T *p)
+{
+  /* Constructs are reduced to units in an attempt to limit spurious
+     diagnostics.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      /* Some implementations allow selection from a tertiary, when there is no
+	 risk of ambiguity. GCC follows RR, so some extra attention here to
+	 guide an unsuspecting user.  */
+    if (a68_whether (q, SELECTOR, -SECONDARY, STOP))
+      {
+	a68_error (NEXT (q), "expected A", SECONDARY);
+	reduce (q, NO_NOTE, NO_TICK, UNIT, SELECTOR, WILDCARD, STOP);
+      }
+
+    /* Attention for identity relations that require tertiaries.  */
+    if (a68_whether (q, -TERTIARY, IS_SYMBOL, TERTIARY, STOP)
+	|| a68_whether (q, TERTIARY, IS_SYMBOL, -TERTIARY, STOP)
+	|| a68_whether (q, -TERTIARY, IS_SYMBOL, -TERTIARY, STOP))
+      {
+	a68_error (NEXT (q), "expected A", TERTIARY);
+	reduce (q, NO_NOTE, NO_TICK, UNIT, WILDCARD, IS_SYMBOL, WILDCARD, STOP);
+      }
+    else if (a68_whether (q, -TERTIARY, ISNT_SYMBOL, TERTIARY, STOP)
+	     || a68_whether (q, TERTIARY, ISNT_SYMBOL, -TERTIARY, STOP)
+	     || a68_whether (q, -TERTIARY, ISNT_SYMBOL, -TERTIARY, STOP))
+      {
+	a68_error (NEXT (q), "expected A", TERTIARY);
+	reduce (q, NO_NOTE, NO_TICK, UNIT, WILDCARD, ISNT_SYMBOL, WILDCARD, STOP);
+      }
+    }
+}
+
+/*
+ * A posteriori checks of the syntax tree built by the BU parser.
+ */
+
+/* Driver for a posteriori error checking.  */
+
+void
+a68_bottom_up_error_check (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, BOOLEAN_PATTERN))
+	{
+	  int k = 0;
+	  a68_count_pictures (SUB (p), &k);
+	  if (!(k == 0 || k == 2))
+	    a68_error (p, "incorrect number of pictures for A",
+		       ATTRIBUTE (p));
+	}
+      else
+	a68_bottom_up_error_check (SUB (p));
+    }
+}
+
+/*
+ * Next part rearranges and checks the tree after the symbol tables are finished.
+ */
+
+/* Transfer IDENTIFIER to JUMP where appropriate.  */
+
+void
+a68_rearrange_goto_less_jumps (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, UNIT))
+	{
+	  NODE_T *q = SUB (p);
+	  if (IS (q, TERTIARY))
+	    {
+	      NODE_T *tertiary = q;
+	      q = SUB (q);
+	      if (q != NO_NODE && IS (q, SECONDARY))
+		{
+		  q = SUB (q);
+		  if (q != NO_NODE && IS (q, PRIMARY))
+		    {
+		      q = SUB (q);
+		      if (q != NO_NODE && IS (q, IDENTIFIER))
+			{
+			  if (a68_is_identifier_or_label_global (TABLE (q), NSYMBOL (q)) == LABEL)
+			    {
+			      ATTRIBUTE (tertiary) = JUMP;
+			      SUB (tertiary) = q;
+			    }
+			}
+		    }
+		}
+	    }
+	}
+      else if (IS (p, TERTIARY))
+	{
+	  NODE_T *q = SUB (p);
+	  if (q != NO_NODE && IS (q, SECONDARY))
+	    {
+	      NODE_T *secondary = q;
+	      q = SUB (q);
+	      if (q != NO_NODE && IS (q, PRIMARY))
+		{
+		  q = SUB (q);
+		  if (q != NO_NODE && IS (q, IDENTIFIER))
+		    {
+		      if (a68_is_identifier_or_label_global (TABLE (q), NSYMBOL (q)) == LABEL)
+			{
+			  ATTRIBUTE (secondary) = JUMP;
+			  SUB (secondary) = q;
+			}
+		    }
+		}
+	    }
+	}
+      else if (IS (p, SECONDARY))
+	{
+	  NODE_T *q = SUB (p);
+	  if (q != NO_NODE && IS (q, PRIMARY))
+	    {
+	      NODE_T *primary = q;
+	      q = SUB (q);
+	      if (q != NO_NODE && IS (q, IDENTIFIER))
+		{
+		  if (a68_is_identifier_or_label_global (TABLE (q), NSYMBOL (q)) == LABEL)
+		    {
+		      ATTRIBUTE (primary) = JUMP;
+		      SUB (primary) = q;
+		    }
+		}
+	    }
+	}
+      else if (IS (p, PRIMARY))
+	{
+	  NODE_T *q = SUB (p);
+	  if (q != NO_NODE && IS (q, IDENTIFIER))
+	    {
+	      if (a68_is_identifier_or_label_global (TABLE (q), NSYMBOL (q)) == LABEL)
+		a68_make_sub (q, q, JUMP);
+	    }
+	}
+      a68_rearrange_goto_less_jumps (SUB (p));
+    }
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-brackets.cc
@@ -0,0 +1,220 @@
+/* Recursive-descent parenthesis checker.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "a68.h"
+
+/* After this checker, we know that at least brackets are matched.  This
+   stabilises later parser phases.
+
+   Note that this checker operates on a linear list of nodes.
+   
+   Error diagnostics are placed near offending lines.  */
+
+/* Intelligible diagnostics for the bracket checker.  */
+
+static void
+bracket_check_error (char *txt, int n, const char *bra, const char *ket)
+{
+  BUFFER buf;
+
+  if (n == 0)
+    return;
+
+  BUFCLR (buf);
+  if (snprintf (buf, SNPRINTF_SIZE, "\"%s\" without matching \"%s\"",
+		(n > 0 ? bra : ket), (n > 0 ? ket : bra)) < 0)
+    gcc_unreachable ();
+
+  if (strlen (txt) > 0)
+    a68_bufcat (txt, " or ", BUFFER_SIZE);
+  a68_bufcat (txt, buf, BUFFER_SIZE);
+}
+
+/* Diagnose brackets in local branch of the tree.  */
+
+static char *
+bracket_check_diagnose (NODE_T *p)
+{
+  int begins = 0, opens = 0, format_delims = 0, format_opens = 0;
+  int subs = 0, ifs = 0, cases = 0, dos = 0;
+
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      switch (ATTRIBUTE (p))
+	{
+	case BEGIN_SYMBOL:
+	  begins++;
+	  break;
+	case END_SYMBOL:
+	  begins--;
+	  break;
+	case OPEN_SYMBOL:
+	  opens++;
+	  break;
+	case CLOSE_SYMBOL:
+	  opens--;
+	  break;
+	case FORMAT_DELIMITER_SYMBOL:
+	  if (format_delims == 0)
+	    format_delims = 1;
+	  else
+	    format_delims = 0;
+	  break;
+	case FORMAT_OPEN_SYMBOL:
+	  format_opens++;
+	  break;
+	case FORMAT_CLOSE_SYMBOL:
+	  format_opens--;
+	  break;
+	case SUB_SYMBOL:
+	  subs++;
+	  break;
+	case BUS_SYMBOL:
+	  subs--;
+	  break;
+	case IF_SYMBOL:
+	  ifs++;
+	  break;
+	case FI_SYMBOL:
+	  ifs--;
+	  break;
+	case CASE_SYMBOL:
+	  cases++;
+	  break;
+	case ESAC_SYMBOL:
+	  cases--;
+	  break;
+	case DO_SYMBOL:
+	  dos++;
+	  break;
+	case OD_SYMBOL:
+	  dos--;
+	  break;
+	default:
+	  break;
+	}
+    }
+
+  A68 (edit_line)[0] = '\0';
+  bracket_check_error (A68 (edit_line), begins, "BEGIN", "END");
+  bracket_check_error (A68 (edit_line), opens, "(", ")");
+  bracket_check_error (A68 (edit_line), format_opens, "(", ")");
+  bracket_check_error (A68 (edit_line), format_delims, "$", "$");
+  bracket_check_error (A68 (edit_line), subs, "[", "]");
+  bracket_check_error (A68 (edit_line), ifs, "IF", "FI");
+  bracket_check_error (A68 (edit_line), cases, "CASE", "ESAC");
+  bracket_check_error (A68 (edit_line), dos, "DO", "OD");
+  return A68 (edit_line);
+}
+
+/* Driver for locally diagnosing non-matching tokens.  */
+
+static NODE_T *
+bracket_check_parse (NODE_T *top, NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      int ket = STOP;
+      NODE_T *q = NO_NODE;
+      bool ignore_token = false;
+
+      switch (ATTRIBUTE (p))
+	{
+	case BEGIN_SYMBOL:
+	  ket = END_SYMBOL;
+	  q = bracket_check_parse (top, NEXT (p));
+	  break;
+	case OPEN_SYMBOL:
+	  ket = CLOSE_SYMBOL;
+	  q = bracket_check_parse (top, NEXT (p));
+	  break;
+	case FORMAT_OPEN_SYMBOL:
+	  ket = FORMAT_CLOSE_SYMBOL;
+	  q = bracket_check_parse (top, NEXT (p));
+	  break;
+	case SUB_SYMBOL:
+	  ket = BUS_SYMBOL;
+	  q = bracket_check_parse (top, NEXT (p));
+	  break;
+	case IF_SYMBOL:
+	  ket = FI_SYMBOL;
+	  q = bracket_check_parse (top, NEXT (p));
+	  break;
+	case CASE_SYMBOL:
+	  ket = ESAC_SYMBOL;
+	  q = bracket_check_parse (top, NEXT (p));
+	  break;
+	case DO_SYMBOL:
+	  ket = OD_SYMBOL;
+	  q = bracket_check_parse (top, NEXT (p));
+	  break;
+	case END_SYMBOL:
+	case CLOSE_SYMBOL:
+	case FORMAT_CLOSE_SYMBOL:
+	case BUS_SYMBOL:
+	case FI_SYMBOL:
+	case ESAC_SYMBOL:
+	case OD_SYMBOL:
+	  return p;
+	default:
+	  ignore_token = true;
+	}
+
+      if (ignore_token)
+	;
+      else if (q != NO_NODE && IS (q, ket))
+	p = q;
+      else if (q == NO_NODE)
+	{
+	  char *diag = bracket_check_diagnose (top);
+	  a68_error (p, "incorrect nesting, check for Y",
+		     (strlen (diag) > 0 ? diag : "missing or unmatched keyword"));
+	  longjmp (A68_PARSER (top_down_crash_exit), 1);
+	}
+      else
+	{
+	  char *diag = bracket_check_diagnose (top);
+	  a68_error (p, "encountered X L but expected X, check for Y",
+		     ATTRIBUTE (q), LINE (INFO (q)),
+		     ket, (strlen (diag) > 0 ? diag : "missing or unmatched keyword"));
+	  longjmp (A68_PARSER (top_down_crash_exit), 1);
+	}
+    }
+  return NO_NODE;
+}
+
+/* Driver for globally diagnosing non-matching tokens.  */
+
+void
+a68_check_parenthesis (NODE_T *top)
+{
+  if (!setjmp (A68_PARSER (top_down_crash_exit)))
+    {
+      if (bracket_check_parse (top, top) != NO_NODE)
+	a68_error (top, "incorrect nesting, check for Y",
+		   "missing or unmatched keyword");
+    }
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-debug.cc
@@ -0,0 +1,90 @@
+/* Debug facilities for the Algol 68 parser.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "diagnostic.h"
+
+#include "a68.h"
+
+/* Write a printable representation of the parse tree with top node P to the
+   standard output.  */
+
+static void
+a68_dump_parse_tree_1 (NODE_T *p, int level)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      int i;
+      location_t loc = a68_get_node_location (p);
+
+      for (i = 0; i < level; ++i)
+	printf ("  ");
+      printf ("NODE %d::%s",
+	      NUMBER (p),
+	      a68_attribute_name (ATTRIBUTE (p)));
+
+      if (ATTRIBUTE (p) == IDENTIFIER
+	  || ATTRIBUTE (p) == DEFINING_IDENTIFIER
+	  || ATTRIBUTE (p) == DEFINING_OPERATOR
+	  || ATTRIBUTE (p) == BOLD_TAG)
+	printf (" %s", NSYMBOL (p));
+
+      if (MOID (p) != NO_MOID)
+	{
+	  MOID_T *moid = MOID (p);
+	  char b[BUFFER_SIZE];
+	  b[0] = '\0';
+
+	  if (IS (moid, SERIES_MODE))
+	    {
+	      if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK)
+		a68_bufcat (b, a68_moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p),
+			    BUFFER_SIZE);
+	      else
+		a68_bufcat (b, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
+	    }
+	  else
+	    a68_bufcat (b, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE);
+
+	  printf (" (%s)", b);
+	}
+      printf (" %s:%d:%d",
+	      LOCATION_FILE (loc), LOCATION_LINE (loc),	LOCATION_COLUMN (loc));
+      printf ("\n");
+      a68_dump_parse_tree_1 (SUB (p), level + 1);
+    }
+}
+
+void
+a68_dump_parse_tree (NODE_T *p)
+{
+  a68_dump_parse_tree_1 (p, 0);
+}
+
+void
+a68_dump_modes (MOID_T *moid)
+{
+  for (; moid != NO_MOID; FORWARD (moid))
+    {
+      printf ("%p %s\n", (void *) moid,
+	      a68_moid_to_string (moid, MOID_ERROR_WIDTH, NODE (moid),
+				  true /* indicant_value */));
+    }
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-extract.cc
@@ -0,0 +1,675 @@
+/* Extract tags from phrases.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "a68.h"
+
+/* This is part of the bottom-up parser.  Here is a set of routines that gather
+  definitions from phrases.  This way we can apply tags before defining them.
+  These routines do not look very elegant as they have to scan through all kind
+  of symbols to find a pattern that they recognise.  */
+
+/* Insert alt equals symbol.  */
+
+static void
+insert_alt_equals (NODE_T *p)
+{
+  NODE_T *q = a68_new_node ();
+  *q = *p;
+  INFO (q) = a68_new_node_info ();
+  *INFO (q) = *INFO (p);
+  GINFO (q) = a68_new_genie_info ();
+  *GINFO (q) = *GINFO (p);
+  ATTRIBUTE (q) = ALT_EQUALS_SYMBOL;
+  NSYMBOL (q) = TEXT (a68_add_token (&A68 (top_token), "="));
+  NEXT (p) = q;
+  PREVIOUS (q) = p;
+  if (NEXT (q) != NO_NODE)
+    PREVIOUS (NEXT (q)) = q;
+}
+
+/* Detect redefined keyword.  */
+
+static void
+detect_redefined_keyword (NODE_T *p, int construct)
+{
+  if (p != NO_NODE && a68_whether (p, KEYWORD, EQUALS_SYMBOL, STOP))
+    a68_error (p, "attempt to redefine keyword Y in A",
+	       NSYMBOL (p), construct);
+}
+
+/* Skip anything until a comma, semicolon or EXIT is found.  */
+
+static NODE_T *
+skip_unit (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, COMMA_SYMBOL))
+	return p;
+      else if (IS (p, SEMI_SYMBOL))
+	return p;
+      else if (IS (p, EXIT_SYMBOL))
+	return p;
+    }
+  return NO_NODE;
+}
+
+/* Attribute of entry in symbol table.  */
+
+static int
+find_tag_definition (TABLE_T *table, const char *name)
+{
+  if (table != NO_TABLE)
+    {
+      int ret = 0;
+      bool found = false;
+      for (TAG_T *s = INDICANTS (table); s != NO_TAG && !found; FORWARD (s))
+	{
+	  if (NSYMBOL (NODE (s)) == name)
+	    {
+	      ret += INDICANT;
+	      found = true;
+	    }
+	}
+      found = false;
+      for (TAG_T *s = OPERATORS (table); s != NO_TAG && !found; FORWARD (s))
+	{
+	  if (NSYMBOL (NODE (s)) == name)
+	    {
+	      ret += OPERATOR;
+	      found = true;
+	    }
+	}
+      if (ret == 0)
+	return find_tag_definition (PREVIOUS (table), name);
+      else
+	return ret;
+    }
+  else
+    return 0;
+}
+
+/* Fill in whether bold tag is operator or indicant.  */
+
+void
+a68_elaborate_bold_tags (NODE_T *p)
+{
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (IS (q, BOLD_TAG))
+	{
+	  switch (find_tag_definition (TABLE (q), NSYMBOL (q)))
+	    {
+	    case 0:
+	      a68_error (q, "tag S has not been declared properly");
+	      break;
+	    case INDICANT:
+	      ATTRIBUTE (q) = INDICANT;
+	      break;
+	    case OPERATOR:
+	      ATTRIBUTE (q) = OPERATOR;
+	      break;
+	    }
+	}
+    }
+}
+
+/* Skip declarer, or argument pack and declarer.  */
+
+static NODE_T *
+skip_pack_declarer (NODE_T *p)
+{
+  /* Skip () REF [] REF FLEX [] [] ...  */
+  while (p != NO_NODE
+	 && (a68_is_one_of (p, SUB_SYMBOL, OPEN_SYMBOL, REF_SYMBOL,
+			    FLEX_SYMBOL, SHORT_SYMBOL, LONG_SYMBOL, STOP)))
+    {
+      FORWARD (p);
+    }
+
+  /* Skip STRUCT (), UNION () or PROC [()].  */
+  if (p != NO_NODE && (a68_is_one_of (p, STRUCT_SYMBOL, UNION_SYMBOL, STOP)))
+    return NEXT (p);
+  else if (p != NO_NODE && IS (p, PROC_SYMBOL))
+    return skip_pack_declarer (NEXT (p));
+  else
+    return p;
+}
+
+/* Search MODE A = .., B = .. and store indicants.  */
+
+void
+a68_extract_indicants (NODE_T *p)
+{
+  NODE_T *q = p;
+
+  while (q != NO_NODE)
+    {
+      if (IS (q, MODE_SYMBOL))
+	{
+	  bool siga = true;
+	  do
+	    {
+	      FORWARD (q);
+	      detect_redefined_keyword (q, MODE_DECLARATION);
+	      if (a68_whether (q, BOLD_TAG, EQUALS_SYMBOL, STOP))
+		{
+		  /* Store in the symbol table, but also in the moid list.
+		     Position of definition (q) connects to this lexical
+		     level!  */
+		  if (a68_add_tag (TABLE (p), INDICANT, q, NO_MOID, STOP) == NO_TAG)
+		    gcc_unreachable ();
+		  if (a68_add_mode (&TOP_MOID (&A68_JOB), INDICANT, 0, q, NO_MOID, NO_PACK) == NO_MOID)
+		    gcc_unreachable ();
+		  ATTRIBUTE (q) = DEFINING_INDICANT;
+		  FORWARD (q);
+		  ATTRIBUTE (q) = ALT_EQUALS_SYMBOL;
+		  q = skip_pack_declarer (NEXT (q));
+		  FORWARD (q);
+		}
+	      else
+		siga = false;
+	    }
+	  while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL));
+	}
+      else
+	FORWARD (q);
+    }
+}
+
+#define GET_PRIORITY(q, k)						\
+  do									\
+    {									\
+      errno=0;								\
+      (k) = atoi (NSYMBOL (q));						\
+      if (errno != 0) {							\
+	a68_error ((q), "invalid priority declaration");		\
+	(k) = MAX_PRIORITY;						\
+      } else if ((k) < 1 || (k) > MAX_PRIORITY) {			\
+	a68_error ((q), "invalid priority declaration");		\
+	(k) = MAX_PRIORITY;						\
+      }									\
+    }									\
+  while (0)
+
+/* Search PRIO X = .., Y = .. and store priorities.  */
+
+void
+a68_extract_priorities (NODE_T *p)
+{
+  NODE_T *q = p;
+  while (q != NO_NODE)
+    {
+      if (IS (q, PRIO_SYMBOL))
+	{
+	  bool siga = true;
+	  do
+	    {
+	      FORWARD (q);
+	      detect_redefined_keyword (q, PRIORITY_DECLARATION);
+	      /* An operator tag like ++ or && gives strange errors so we catch
+		 it here.  */
+	      if (a68_whether (q, OPERATOR, OPERATOR, STOP))
+		{
+		  NODE_T *y = q;
+		  a68_error (q, "invalid operator tag");
+		  ATTRIBUTE (q) = DEFINING_OPERATOR;
+		  /* Remove one superfluous operator, and hope it was only
+		     one.  */
+		  NEXT (q) = NEXT_NEXT (q);
+		  PREVIOUS (NEXT (q)) = q;
+		  FORWARD (q);
+		  ATTRIBUTE (q) = ALT_EQUALS_SYMBOL;
+		  FORWARD (q);
+		  int k;
+		  GET_PRIORITY (q, k);
+		  ATTRIBUTE (q) = PRIORITY;
+		  if (a68_add_tag (TABLE (p), PRIO_SYMBOL, y, NO_MOID, k) == NO_TAG)
+		    gcc_unreachable ();
+		  FORWARD (q);
+		}
+	      else if (a68_whether (q, OPERATOR, EQUALS_SYMBOL, INT_DENOTATION, STOP)
+		       || a68_whether (q, EQUALS_SYMBOL, EQUALS_SYMBOL, INT_DENOTATION, STOP))
+		{
+		  NODE_T *y = q;
+		  ATTRIBUTE (q) = DEFINING_OPERATOR;
+		  FORWARD (q);
+		  ATTRIBUTE (q) = ALT_EQUALS_SYMBOL;
+		  FORWARD (q);
+		  int k;
+		  GET_PRIORITY (q, k);
+		  ATTRIBUTE (q) = PRIORITY;
+		  if (a68_add_tag (TABLE (p), PRIO_SYMBOL, y, NO_MOID, k) == NO_TAG)
+		    gcc_unreachable ();
+		  FORWARD (q);
+		}
+	      else if (a68_whether (q, BOLD_TAG, IDENTIFIER, STOP))
+		{
+		  siga = false;
+		}
+	      else if (a68_whether (q, BOLD_TAG, EQUALS_SYMBOL, INT_DENOTATION, STOP))
+		{
+		  NODE_T *y = q;
+		  ATTRIBUTE (q) = DEFINING_OPERATOR;
+		  FORWARD (q);
+		  ATTRIBUTE (q) = ALT_EQUALS_SYMBOL;
+		  FORWARD (q);
+		  int k;
+		  GET_PRIORITY (q, k);
+		  ATTRIBUTE (q) = PRIORITY;
+		  if (a68_add_tag (TABLE (p), PRIO_SYMBOL, y, NO_MOID, k) == NO_TAG)
+		    gcc_unreachable ();
+		  FORWARD (q);
+		} else if (a68_whether (q, BOLD_TAG, INT_DENOTATION, STOP)
+			   || a68_whether (q, OPERATOR, INT_DENOTATION, STOP)
+			   || a68_whether (q, EQUALS_SYMBOL, INT_DENOTATION, STOP))
+		{
+		  /* The scanner cannot separate operator and "=" sign so we do this here.  */
+		  int len = (int) strlen (NSYMBOL (q));
+		  if (len > 1 && NSYMBOL (q)[len - 1] == '=')
+		    {
+		      NODE_T *y = q;
+		      char *sym = (char *) xmalloc ((size_t) (len + 1));
+		      a68_bufcpy (sym, NSYMBOL (q), len + 1);
+		      sym[len - 1] = '\0';
+		      NSYMBOL (q) = TEXT (a68_add_token (&A68 (top_token), sym));
+		      if (len > 2 && NSYMBOL (q)[len - 2] == ':' && NSYMBOL (q)[len - 3] != '=')
+			a68_error (q, "probably a missing symbol near invalid operator S");
+		      ATTRIBUTE (q) = DEFINING_OPERATOR;
+		      insert_alt_equals (q);
+		      q = NEXT_NEXT (q);
+		      int k;
+		      GET_PRIORITY (q, k);
+		      ATTRIBUTE (q) = PRIORITY;
+		      if (a68_add_tag (TABLE (p), PRIO_SYMBOL, y, NO_MOID, k) == NO_TAG)
+			gcc_unreachable ();
+		      FORWARD (q);
+		    }
+		  else
+		    siga = false;
+		}
+	      else
+		siga = false;
+	    }
+	  while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL));
+	}
+      else
+	FORWARD (q);
+    }
+}
+
+/* Search OP [( .. ) ..] X = .., Y = .. and store operators.  */
+
+void
+a68_extract_operators (NODE_T *p)
+{
+  NODE_T *q = p;
+
+  while (q != NO_NODE)
+    {
+      if (!IS (q, OP_SYMBOL))
+	FORWARD (q);
+      else
+	{
+	  bool siga = true;
+	  bool in_proc = true;
+	  /* Skip operator plan.  */
+	  if (NEXT (q) != NO_NODE && IS (NEXT (q), OPEN_SYMBOL))
+	    {
+	      q = skip_pack_declarer (NEXT (q));
+	      in_proc = false;
+	    }
+	  /* Sample operators.  */
+	  if (q != NO_NODE)
+	    {
+	      do
+		{
+		  FORWARD (q);
+		  detect_redefined_keyword (q, OPERATOR_DECLARATION);
+		  /* Unacceptable operator tags like ++ or && could give
+		     strange errors.  */
+		  if (a68_whether (q, OPERATOR, OPERATOR, STOP))
+		    {
+		      a68_error (q, "invalid operator tag");
+		      ATTRIBUTE (q) = DEFINING_OPERATOR;
+		      TAG_T *t = a68_add_tag (TABLE (p), OP_SYMBOL, q, NO_MOID, STOP);
+		      if (t == NO_TAG)
+			gcc_unreachable ();
+		      IN_PROC (t) = in_proc;
+		      /* Remove one superfluous operator, and hope it was only one.  */
+		      NEXT (q) = NEXT_NEXT (q);
+		      PREVIOUS (NEXT (q)) = q;
+		      FORWARD (q);
+		      ATTRIBUTE (q) = ALT_EQUALS_SYMBOL;
+		      q = skip_unit (q);
+		    }
+		  else if (a68_whether (q, OPERATOR, EQUALS_SYMBOL, STOP)
+			   || a68_whether (q, EQUALS_SYMBOL, EQUALS_SYMBOL, STOP))
+		    {
+		      ATTRIBUTE (q) = DEFINING_OPERATOR;
+		      TAG_T *t = a68_add_tag (TABLE (p), OP_SYMBOL, q, NO_MOID, STOP);
+		      if (t == NO_TAG)
+			gcc_unreachable ();
+		      IN_PROC (t) = in_proc;
+		      FORWARD (q);
+		      ATTRIBUTE (q) = ALT_EQUALS_SYMBOL;
+		      q = skip_unit (q);
+		    }
+		  else if (a68_whether (q, BOLD_TAG, IDENTIFIER, STOP))
+		    {
+		      siga = false;
+		    }
+		  else if (a68_whether (q, BOLD_TAG, EQUALS_SYMBOL, STOP))
+		    {
+		      ATTRIBUTE (q) = DEFINING_OPERATOR;
+		      TAG_T *t = a68_add_tag (TABLE (p), OP_SYMBOL, q, NO_MOID, STOP);
+		      if (t == NO_TAG)
+			gcc_unreachable ();
+		      IN_PROC (t) = in_proc;
+		      FORWARD (q);
+		      ATTRIBUTE (q) = ALT_EQUALS_SYMBOL;
+		      q = skip_unit (q);
+		    }
+		  else if (q != NO_NODE && (a68_is_one_of (q, OPERATOR, BOLD_TAG, EQUALS_SYMBOL, STOP)))
+		    {
+		      /* The scanner cannot separate operator and "=" sign so
+			 we do this here.  */
+		      int len = (int) strlen (NSYMBOL (q));
+		      if (len > 1 && NSYMBOL (q)[len - 1] == '=')
+			{
+			  char *sym = (char *) xmalloc ((size_t) (len + 1));
+			  a68_bufcpy (sym, NSYMBOL (q), len + 1);
+			  sym[len - 1] = '\0';
+			  NSYMBOL (q) = TEXT (a68_add_token (&A68 (top_token), sym));
+			  if (len > 2 && NSYMBOL (q)[len - 2] == ':' && NSYMBOL (q)[len - 3] != '=')
+			    a68_error (q, "probably a missing symbol near invalid operator S");
+			  ATTRIBUTE (q) = DEFINING_OPERATOR;
+			  insert_alt_equals (q);
+			  TAG_T *t = a68_add_tag (TABLE (p), OP_SYMBOL, q, NO_MOID, STOP);
+			  if (t == NO_TAG)
+			    gcc_unreachable ();
+			  IN_PROC (t) = in_proc;
+			  FORWARD (q);
+			  q = skip_unit (q);
+			}
+		      else
+			siga = false;
+		    }
+		  else
+		    siga = false;
+		}
+	      while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL));
+	    }
+	}
+    }
+}
+
+/* Search and store labels.  */
+
+void
+a68_extract_labels (NODE_T *p, int expect)
+{
+  /* Only handle candidate phrases as not to search indexers!.  */
+  if (expect == SERIAL_CLAUSE || expect == ENQUIRY_CLAUSE || expect == SOME_CLAUSE)
+    {
+      for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+	{
+	  if (a68_whether (q, IDENTIFIER, COLON_SYMBOL, STOP))
+	    {
+	      TAG_T *z = a68_add_tag (TABLE (p), LABEL, q, NO_MOID, LOCAL_LABEL);
+	      ATTRIBUTE (q) = DEFINING_IDENTIFIER;
+	      UNIT (z) = NO_NODE;
+	    }
+	}
+    }
+}
+
+/* Search MOID x = .., y = .. and store identifiers.  */
+
+static void
+extract_identities (NODE_T *p)
+{
+  NODE_T *q = p;
+
+  while (q != NO_NODE)
+    {
+      if (a68_whether (q, DECLARER, IDENTIFIER, EQUALS_SYMBOL, STOP))
+	{
+	  bool siga = true;
+	  do
+	    {
+	      if (a68_whether ((FORWARD (q)), IDENTIFIER, EQUALS_SYMBOL, STOP))
+		{
+		  TAG_T *tag = a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER);
+		  if (tag == NO_TAG)
+		    gcc_unreachable ();
+		  ATTRIBUTE (q) = DEFINING_IDENTIFIER;
+		  FORWARD (q);
+		  ATTRIBUTE (q) = ALT_EQUALS_SYMBOL;
+		  q = skip_unit (q);
+		}
+	      else if (a68_whether (q, IDENTIFIER, ASSIGN_SYMBOL, STOP))
+		{
+		  /* Handle common error in ALGOL 68 programs.  */
+		  a68_error (q, "mixed identity-declaration and variable-declaration");
+		  if (a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER) == NO_TAG)
+		    gcc_unreachable ();
+		  ATTRIBUTE (q) = DEFINING_IDENTIFIER;
+		  ATTRIBUTE (FORWARD (q)) = ALT_EQUALS_SYMBOL;
+		  q = skip_unit (q);
+		}
+	      else
+		siga = false;
+	    }
+	  while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL));
+	}
+      else
+	FORWARD (q);
+    }
+}
+
+/* Search MOID x [:= ..], y [:= ..] and store identifiers.  */
+
+static void
+extract_variables (NODE_T *p)
+{
+  NODE_T *q = p;
+
+  while (q != NO_NODE)
+    {
+      if (a68_whether (q, HEAP_SYMBOL, DECLARER, IDENTIFIER, STOP)
+	  || a68_whether (q, LOC_SYMBOL, DECLARER, IDENTIFIER, STOP)
+	  || a68_whether (q, DECLARER, IDENTIFIER, STOP))
+	{
+	  if (!IS (q, DECLARER))
+	    FORWARD (q);
+
+	  bool siga = true;
+	  do
+	    {
+	      FORWARD (q);	      
+	      if (a68_whether (q, IDENTIFIER, STOP))
+		{
+		  if (a68_whether (q, IDENTIFIER, EQUALS_SYMBOL, STOP))
+		    {
+		      /* Handle common error in ALGOL 68 programs.  */
+		      a68_error (q, "mixed identity-declaration and variable-declaration");
+		      ATTRIBUTE (NEXT (q)) = ASSIGN_SYMBOL;
+		    }
+		  TAG_T *tag = a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER);
+		  if (tag == NO_TAG)
+		    gcc_unreachable ();
+		  VARIABLE (tag) = true;
+		  ATTRIBUTE (q) = DEFINING_IDENTIFIER;
+		  q = skip_unit (q);
+		}
+	      else
+		siga = false;
+	    }
+	  while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL));
+	}
+      else
+	FORWARD (q);
+    }
+}
+
+/* Search PROC x = .., y = .. and stores identifiers.  */
+
+static void
+extract_proc_identities (NODE_T *p)
+{
+  NODE_T *q = p;
+
+  while (q != NO_NODE)
+    {
+      if (a68_whether (q, PROC_SYMBOL, IDENTIFIER, EQUALS_SYMBOL, STOP))
+	{
+	  bool siga = true;
+	  do
+	    {
+	      FORWARD (q);
+	      if (a68_whether (q, IDENTIFIER, EQUALS_SYMBOL, STOP))
+		{
+		  TAG_T *t = a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER);
+		  IN_PROC (t) = true;
+		  ATTRIBUTE (q) = DEFINING_IDENTIFIER;
+		  ATTRIBUTE (FORWARD (q)) = ALT_EQUALS_SYMBOL;
+		  q = skip_unit (q);
+		}
+	      else if (a68_whether (q, IDENTIFIER, ASSIGN_SYMBOL, STOP))
+		{
+		  /* Handle common error in ALGOL 68 programs. */
+		  a68_error (q, "mixed identity-declaration and variable-declaration");
+		  if (a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER) == NO_TAG)
+		    gcc_unreachable ();
+		  ATTRIBUTE (q) = DEFINING_IDENTIFIER;
+		  ATTRIBUTE (FORWARD (q)) = ALT_EQUALS_SYMBOL;
+		  q = skip_unit (q);
+		}
+	      else
+		siga = false;
+	    }
+	  while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL));
+	}
+      else
+	FORWARD (q);
+    }
+}
+
+/* Search PROC x [:= ..], y [:= ..]; store identifiers.  */
+
+static void
+extract_proc_variables (NODE_T *p)
+{
+  NODE_T *q = p;
+
+  while (q != NO_NODE)
+    {
+      if (a68_whether (q, PROC_SYMBOL, IDENTIFIER, STOP))
+	{
+	  bool siga = true;
+	  do
+	    {
+	      FORWARD (q);
+	      if (a68_whether (q, IDENTIFIER, ASSIGN_SYMBOL, STOP))
+		{
+		  if (a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER) == NO_TAG)
+		    gcc_unreachable ();
+		  ATTRIBUTE (q) = DEFINING_IDENTIFIER;
+		  q = skip_unit (FORWARD (q));
+		}
+	      else if (a68_whether (q, IDENTIFIER, EQUALS_SYMBOL, STOP))
+		{
+		  /* Handle common error in ALGOL 68 programs.  */
+		  a68_error (q, "mixed identity-declaration and variable-declaration");
+		  if (a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER) == NO_TAG)
+		    gcc_unreachable ();
+		  ATTRIBUTE (q) = DEFINING_IDENTIFIER;
+		  ATTRIBUTE (FORWARD (q)) = ASSIGN_SYMBOL;
+		  q = skip_unit (q);
+		} else
+		siga = false;
+	    }
+	  while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL));
+	}
+      else
+	FORWARD (q);
+    }
+}
+
+/* Schedule gathering of definitions in a phrase.  */
+
+void
+a68_extract_declarations (NODE_T *p)
+{
+  /* Get definitions so we know what is defined in this range.  */
+  extract_identities (p);
+  extract_variables (p);
+  extract_proc_identities (p);
+  extract_proc_variables (p);
+  /* By now we know whether "=" is an operator or not.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (IS (q, EQUALS_SYMBOL))
+	ATTRIBUTE (q) = OPERATOR;
+      else if (IS (q, ALT_EQUALS_SYMBOL))
+	ATTRIBUTE (q) = EQUALS_SYMBOL;
+    }
+
+  /* Get qualifiers.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (a68_whether (q, LOC_SYMBOL, DECLARER, DEFINING_IDENTIFIER, STOP))
+	a68_make_sub (q, q, QUALIFIER);
+      if (a68_whether (q, HEAP_SYMBOL, DECLARER, DEFINING_IDENTIFIER, STOP))
+	a68_make_sub (q, q, QUALIFIER);
+      if (a68_whether (q, LOC_SYMBOL, PROC_SYMBOL, DEFINING_IDENTIFIER, STOP))
+	a68_make_sub (q, q, QUALIFIER);
+      if (a68_whether (q, HEAP_SYMBOL, PROC_SYMBOL, DEFINING_IDENTIFIER, STOP))
+	a68_make_sub (q, q, QUALIFIER);
+    }
+
+  /* Give priorities to operators.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (IS (q, OPERATOR))
+	{
+	  if (a68_find_tag_global (TABLE (q), OP_SYMBOL, NSYMBOL (q)))
+	    {
+	      TAG_T *s = a68_find_tag_global (TABLE (q), PRIO_SYMBOL, NSYMBOL (q));
+
+	      if (s != NO_TAG)
+		PRIO (INFO (q)) = PRIO (s);
+	      else
+		PRIO (INFO (q)) = 0;
+	    }
+	  else
+	    {
+	      a68_error (q, "tag S has not been declared properly");
+	      PRIO (INFO (q)) = 1;
+	    }
+	}
+    }
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-keywords.cc
@@ -0,0 +1,226 @@
+/* Keyword tables.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "a68.h"
+
+/* Add token to the token tree.  */
+
+TOKEN_T *
+a68_add_token (TOKEN_T **p, const char *t)
+{
+  char *z = xstrdup (t);
+  while (*p != NO_TOKEN)
+    {
+      int k = strcmp (z, TEXT (*p));
+
+      if (k < 0)
+	p = &LESS (*p);
+      else if (k > 0)
+	p = &MORE (*p);
+      else
+	return *p;
+    }
+
+  *p = (TOKEN_T *) xmalloc (sizeof (TOKEN_T));
+  TEXT (*p) = z;
+  LESS (*p) = MORE (*p) = NO_TOKEN;
+  return *p;
+}
+
+/*  Find keyword, from token name.  */
+
+KEYWORD_T *
+a68_find_keyword (KEYWORD_T *p, const char *t)
+{
+  while (p != NO_KEYWORD)
+    {
+      bool case_insensitive = (OPTION_STROPPING (&A68_JOB) == SUPPER_STROPPING);
+      int k = (case_insensitive
+	       ? strcasecmp (t, TEXT (p))
+	       : strcmp (t, TEXT (p)));
+
+      if (k < 0)
+	p = LESS (p);
+      else if (k > 0)
+	p = MORE (p);
+      else
+	return p;
+    }
+
+  return NO_KEYWORD;
+}
+
+/* Find keyword, from attribute.  */
+
+KEYWORD_T *
+a68_find_keyword_from_attribute (KEYWORD_T *p, enum a68_attribute a)
+{
+  if (p == NO_KEYWORD)
+    return NO_KEYWORD;
+  else if (a == ATTRIBUTE (p))
+    return p;
+  else
+    {
+      KEYWORD_T *z;
+
+      if ((z = a68_find_keyword_from_attribute (LESS (p), a)) != NO_KEYWORD)
+	return z;
+      else if ((z = a68_find_keyword_from_attribute (MORE (p), a)) != NO_KEYWORD)
+	return z;
+    }
+
+  return NO_KEYWORD;
+}
+
+/* Add keyword to the tree.  */
+
+static void
+add_keyword (KEYWORD_T **p, enum a68_attribute a, const char *t)
+{
+  while (*p != NO_KEYWORD)
+    {
+      bool case_insensitive = (OPTION_STROPPING (&A68_JOB) == SUPPER_STROPPING);
+      int k = (case_insensitive
+	       ? strcasecmp (t, TEXT (*p))
+	       : strcmp (t, TEXT (*p)));
+      if (k < 0)
+	p = &LESS (*p);
+      else
+	p = &MORE (*p);
+    }
+
+  *p = (KEYWORD_T *) xmalloc (sizeof (KEYWORD_T));
+  ATTRIBUTE (*p) = a;
+  TEXT (*p) = t;
+  LESS (*p) = MORE (*p) = NO_KEYWORD;
+}
+
+/* Make tables of keywords and non-terminals.  */
+
+void
+a68_set_up_tables (void)
+{
+  /* Entries are randomised to balance the tree.  */
+  if (OPTION_STRICT (&A68_JOB) == false)
+    {
+      add_keyword (&A68 (top_keyword), ANDF_SYMBOL, "ANDTH");
+      add_keyword (&A68 (top_keyword), ORF_SYMBOL, "OREL");
+      add_keyword (&A68 (top_keyword), BRIEF_COMMENT_BEGIN_SYMBOL, "{");
+      add_keyword (&A68 (top_keyword), BRIEF_COMMENT_END_SYMBOL, "}");
+
+      if (OPTION_STROPPING (&A68_JOB) != SUPPER_STROPPING)
+	{
+	  add_keyword (&A68 (top_keyword), BOLD_COMMENT_BEGIN_SYMBOL, "NOTE");
+	  add_keyword (&A68 (top_keyword), BOLD_COMMENT_END_SYMBOL, "ETON");
+	}
+    }
+
+  if (OPTION_STROPPING (&A68_JOB) != SUPPER_STROPPING)
+    {
+      /* The following representations do not work well with stropping regimes
+	 in which reserved words live in the same namespace than
+	 tags/identifiers.  The alternative "brief" representations for these
+	 symbols shall be used instead.  */
+      add_keyword (&A68 (top_keyword), STYLE_I_COMMENT_SYMBOL, "CO");
+      add_keyword (&A68 (top_keyword), BOLD_COMMENT_SYMBOL, "COMMENT");
+      add_keyword (&A68 (top_keyword), STYLE_II_COMMENT_SYMBOL, "#");
+    }
+
+  add_keyword (&A68 (top_keyword), POINT_SYMBOL, ".");
+  add_keyword (&A68 (top_keyword), COLON_SYMBOL, ":");
+  add_keyword (&A68 (top_keyword), THEN_BAR_SYMBOL, "|");
+  add_keyword (&A68 (top_keyword), SUB_SYMBOL, "[");
+  add_keyword (&A68 (top_keyword), BY_SYMBOL, "BY");
+  add_keyword (&A68 (top_keyword), OP_SYMBOL, "OP");
+  add_keyword (&A68 (top_keyword), COMMA_SYMBOL, ",");
+  add_keyword (&A68 (top_keyword), AT_SYMBOL, "AT");
+  add_keyword (&A68 (top_keyword), PRIO_SYMBOL, "PRIO");
+  add_keyword (&A68 (top_keyword), END_SYMBOL, "END");
+  add_keyword (&A68 (top_keyword), GO_SYMBOL, "GO");
+  add_keyword (&A68 (top_keyword), TO_SYMBOL, "TO");
+  add_keyword (&A68 (top_keyword), ELSE_BAR_SYMBOL, "|:");
+  add_keyword (&A68 (top_keyword), THEN_SYMBOL, "THEN");
+  add_keyword (&A68 (top_keyword), TRUE_SYMBOL, "TRUE");
+  add_keyword (&A68 (top_keyword), PROC_SYMBOL, "PROC");
+  add_keyword (&A68 (top_keyword), FOR_SYMBOL, "FOR");
+  add_keyword (&A68 (top_keyword), GOTO_SYMBOL, "GOTO");
+  add_keyword (&A68 (top_keyword), WHILE_SYMBOL, "WHILE");
+  add_keyword (&A68 (top_keyword), IS_SYMBOL, ":=:");
+  add_keyword (&A68 (top_keyword), ASSIGN_TO_SYMBOL, "=:");
+  add_keyword (&A68 (top_keyword), COMPL_SYMBOL, "COMPL");
+  add_keyword (&A68 (top_keyword), FROM_SYMBOL, "FROM");
+  add_keyword (&A68 (top_keyword), BOLD_PRAGMAT_SYMBOL, "PRAGMAT");
+  add_keyword (&A68 (top_keyword), DO_SYMBOL, "DO");
+  add_keyword (&A68 (top_keyword), CASE_SYMBOL, "CASE");
+  add_keyword (&A68 (top_keyword), LOC_SYMBOL, "LOC");
+  add_keyword (&A68 (top_keyword), CHAR_SYMBOL, "CHAR");
+  add_keyword (&A68 (top_keyword), ISNT_SYMBOL, ":/=:");
+  add_keyword (&A68 (top_keyword), REF_SYMBOL, "REF");
+  add_keyword (&A68 (top_keyword), NIL_SYMBOL, "NIL");
+  add_keyword (&A68 (top_keyword), ASSIGN_SYMBOL, ":=");
+  add_keyword (&A68 (top_keyword), FI_SYMBOL, "FI");
+  add_keyword (&A68 (top_keyword), FILE_SYMBOL, "FILE");
+  add_keyword (&A68 (top_keyword), PAR_SYMBOL, "PAR");
+  add_keyword (&A68 (top_keyword), ASSERT_SYMBOL, "ASSERT");
+  add_keyword (&A68 (top_keyword), OUSE_SYMBOL, "OUSE");
+  add_keyword (&A68 (top_keyword), IN_SYMBOL, "IN");
+  add_keyword (&A68 (top_keyword), LONG_SYMBOL, "LONG");
+  add_keyword (&A68 (top_keyword), SEMI_SYMBOL, ";");
+  add_keyword (&A68 (top_keyword), EMPTY_SYMBOL, "EMPTY");
+  add_keyword (&A68 (top_keyword), MODE_SYMBOL, "MODE");
+  add_keyword (&A68 (top_keyword), IF_SYMBOL, "IF");
+  add_keyword (&A68 (top_keyword), OD_SYMBOL, "OD");
+  add_keyword (&A68 (top_keyword), OF_SYMBOL, "OF");
+  add_keyword (&A68 (top_keyword), STRUCT_SYMBOL, "STRUCT");
+  add_keyword (&A68 (top_keyword), STYLE_I_PRAGMAT_SYMBOL, "PR");
+  add_keyword (&A68 (top_keyword), BUS_SYMBOL, "]");
+  add_keyword (&A68 (top_keyword), SKIP_SYMBOL, "SKIP");
+  add_keyword (&A68 (top_keyword), SHORT_SYMBOL, "SHORT");
+  add_keyword (&A68 (top_keyword), IS_SYMBOL, "IS");
+  add_keyword (&A68 (top_keyword), ESAC_SYMBOL, "ESAC");
+  add_keyword (&A68 (top_keyword), CHANNEL_SYMBOL, "CHANNEL");
+  add_keyword (&A68 (top_keyword), REAL_SYMBOL, "REAL");
+  add_keyword (&A68 (top_keyword), STRING_SYMBOL, "STRING");
+  add_keyword (&A68 (top_keyword), BOOL_SYMBOL, "BOOL");
+  add_keyword (&A68 (top_keyword), ISNT_SYMBOL, "ISNT");
+  add_keyword (&A68 (top_keyword), FALSE_SYMBOL, "FALSE");
+  add_keyword (&A68 (top_keyword), UNION_SYMBOL, "UNION");
+  add_keyword (&A68 (top_keyword), OUT_SYMBOL, "OUT");
+  add_keyword (&A68 (top_keyword), BRIEF_COMMENT_END_SYMBOL, "{");
+  add_keyword (&A68 (top_keyword), OPEN_SYMBOL, "(");
+  add_keyword (&A68 (top_keyword), BEGIN_SYMBOL, "BEGIN");
+  add_keyword (&A68 (top_keyword), FLEX_SYMBOL, "FLEX");
+  add_keyword (&A68 (top_keyword), VOID_SYMBOL, "VOID");
+  add_keyword (&A68 (top_keyword), BITS_SYMBOL, "BITS");
+  add_keyword (&A68 (top_keyword), ELSE_SYMBOL, "ELSE");
+  add_keyword (&A68 (top_keyword), EXIT_SYMBOL, "EXIT");
+  add_keyword (&A68 (top_keyword), HEAP_SYMBOL, "HEAP");
+  add_keyword (&A68 (top_keyword), INT_SYMBOL, "INT");
+  add_keyword (&A68 (top_keyword), BYTES_SYMBOL, "BYTES");
+  add_keyword (&A68 (top_keyword), SEMA_SYMBOL, "SEMA");
+  add_keyword (&A68 (top_keyword), CLOSE_SYMBOL, ")");
+  add_keyword (&A68 (top_keyword), AT_SYMBOL, "@");
+  add_keyword (&A68 (top_keyword), ELIF_SYMBOL, "ELIF");
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-modes.cc
@@ -0,0 +1,1302 @@
+/* Mode table management.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "a68.h"
+
+/*
+ * Mode collection, equivalencing and derived modes.
+ */
+
+/* Few forward references.  */
+
+static MOID_T *get_mode_from_declarer (NODE_T *p);
+
+/*
+ * Mode service routines.
+ */
+
+/* Count bounds in declarer in tree.  */
+
+static int
+count_bounds (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return 0;
+  else
+    {
+      if (IS (p, BOUND))
+	return 1 + count_bounds (NEXT (p));
+      else
+	return count_bounds (NEXT (p)) + count_bounds (SUB (p));
+    }
+}
+
+/* Count number of SHORTs or LONGs. */
+
+static int
+count_sizety (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return 0;
+  else if (IS (p, LONGETY))
+    return count_sizety (SUB (p)) + count_sizety (NEXT (p));
+  else if (IS (p, SHORTETY))
+    return count_sizety (SUB (p)) + count_sizety (NEXT (p));
+  else if (IS (p, LONG_SYMBOL))
+    return 1;
+  else if (IS (p, SHORT_SYMBOL))
+    return -1;
+  else
+    return 0;
+}
+
+/* Count moids in a pack.  */
+
+int
+a68_count_pack_members (PACK_T *u)
+{
+  int k = 0;
+
+  for (; u != NO_PACK; FORWARD (u))
+    k++;
+  return k;
+}
+
+/* Replace a mode by its equivalent mode.  */
+
+static void
+resolve_equivalent (MOID_T **m)
+{
+  while ((*m) != NO_MOID
+	 && EQUIVALENT ((*m)) != NO_MOID
+	 && (*m) != EQUIVALENT (*m))
+    {
+      (*m) = EQUIVALENT (*m);
+    }
+}
+
+/* Reset moid.  */
+
+static void
+reset_moid_tree (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      MOID (p) = NO_MOID;
+      reset_moid_tree (SUB (p));
+    }
+}
+
+/* Renumber moids.  */
+
+void
+a68_renumber_moids (MOID_T *p, int n)
+{
+  if (p != NO_MOID)
+    {
+      NUMBER (p) = n;
+      a68_renumber_moids (NEXT (p), n + 1);
+    }
+}
+
+/* Register mode in the global mode table, if mode is unique.  */
+
+MOID_T *
+a68_register_extra_mode (MOID_T **z, MOID_T *u)
+{
+  /* If we already know this mode, return the existing entry; otherwise link it
+     in.  */
+  for (MOID_T *head = TOP_MOID (&A68_JOB); head != NO_MOID; FORWARD (head))
+    {
+      if (a68_prove_moid_equivalence (head, u))
+	return head;
+  }
+
+  /* Link to chain and exit.  */
+  NUMBER (u) = A68 (mode_count)++;
+  NEXT (u) = (*z);
+  return *z = u;
+}
+
+/* Create a new mode and add it to chain Z.  */
+
+MOID_T *
+a68_add_mode (MOID_T **z, int att, int dim, NODE_T *node, MOID_T *sub, PACK_T *pack)
+{
+  MOID_T *new_mode = a68_new_moid ();
+
+  if (sub == NO_MOID)
+    {
+      if (att == REF_SYMBOL
+	  || att == FLEX_SYMBOL
+	  || att == ROW_SYMBOL)
+	gcc_unreachable ();
+    }
+
+  USE (new_mode) = false;
+  ATTRIBUTE (new_mode) = att;
+  DIM (new_mode) = dim;
+  NODE (new_mode) = node;
+  HAS_ROWS (new_mode) = (att == ROW_SYMBOL);
+  SUB (new_mode) = sub;
+  PACK (new_mode) = pack;
+  NEXT (new_mode) = NO_MOID;
+  EQUIVALENT (new_mode) = NO_MOID;
+  SLICE (new_mode) = NO_MOID;
+  DEFLEXED (new_mode) = NO_MOID;
+  NAME (new_mode) = NO_MOID;
+  MULTIPLE (new_mode) = NO_MOID;
+  ROWED (new_mode) = NO_MOID;
+
+  return a68_register_extra_mode (z, new_mode);
+}
+
+/* Contract a UNION.  */
+
+void
+a68_contract_union (MOID_T *u)
+{
+  for (PACK_T *s = PACK (u); s != NO_PACK; FORWARD (s))
+    {
+      PACK_T *t = s;
+
+      while (t != NO_PACK)
+	{
+	  if (NEXT (t) != NO_PACK && MOID (NEXT (t)) == MOID (s))
+	    {
+	      MOID (t) = MOID (t);
+	      NEXT (t) = NEXT_NEXT (t);
+	    }
+	  else
+	    FORWARD (t);
+	}
+    }
+}
+
+/* Absorb UNION pack.  */
+
+PACK_T *
+a68_absorb_union_pack (PACK_T * u)
+{
+  PACK_T *z;
+  bool siga;
+
+  do
+    {
+      z = NO_PACK;
+      siga = false;
+      for (PACK_T *t = u; t != NO_PACK; FORWARD (t))
+	{
+	  if (IS (MOID (t), UNION_SYMBOL))
+	    {
+	      siga = true;
+	      for (PACK_T *s = PACK (MOID (t)); s != NO_PACK; FORWARD (s))
+		(void) a68_add_mode_to_pack (&z, MOID (s), NO_TEXT, NODE (s));
+	    }
+	  else
+	    {
+	      (void) a68_add_mode_to_pack (&z, MOID (t), NO_TEXT, NODE (t));
+	    }
+	}
+      u = z;
+    }
+  while (siga);
+  return z;
+}
+
+/* Add row and its slices to chain, recursively.  */
+
+static MOID_T *
+add_row (MOID_T **p, int dim, MOID_T *sub, NODE_T *n, bool derivate)
+{
+  MOID_T *q = a68_add_mode (p, ROW_SYMBOL, dim, n, sub, NO_PACK);
+
+  DERIVATE (q) |= derivate;
+  if (dim > 1)
+    SLICE (q) = add_row (&NEXT (q), dim - 1, sub, n, derivate);
+  else
+    SLICE (q) = sub;
+  return q;
+}
+
+/* Add a moid to a pack, maybe with a (field) name.  */
+
+void
+a68_add_mode_to_pack (PACK_T **p, MOID_T *m, const char *text, NODE_T *node)
+{
+  PACK_T *z = a68_new_pack ();
+
+  MOID (z) = m;
+  TEXT (z) = text;
+  NODE (z) = node;
+  NEXT (z) = *p;
+  PREVIOUS (z) = NO_PACK;
+  if (NEXT (z) != NO_PACK)
+    PREVIOUS (NEXT (z)) = z;
+
+  /* Link in chain.  */
+  *p = z;
+}
+
+/* Add a moid to a pack, maybe with a (field) name.  */
+
+void
+a68_add_mode_to_pack_end (PACK_T **p, MOID_T *m, const char *text, NODE_T *node)
+{
+  PACK_T *z = a68_new_pack ();
+
+  MOID (z) = m;
+  TEXT (z) = text;
+  NODE (z) = node;
+  NEXT (z) = NO_PACK;
+  if (NEXT (z) != NO_PACK)
+    PREVIOUS (NEXT (z)) = z;
+
+  /* Link in chain.  */
+  while ((*p) != NO_PACK)
+    p = &(NEXT (*p));
+  PREVIOUS (z) = (*p);
+  (*p) = z;
+}
+
+/* Absorb UNION members.  */
+
+static void
+absorb_unions (MOID_T *m)
+{
+  /* UNION (A, UNION (B, C)) = UNION (A, B, C) or
+     UNION (A, UNION (A, B)) = UNION (A, B).  */
+  for (; m != NO_MOID; FORWARD (m))
+    {
+      if (IS (m, UNION_SYMBOL))
+	PACK (m) = a68_absorb_union_pack (PACK (m));
+    }
+}
+
+/* Contract UNIONs.  */
+
+static void
+contract_unions (MOID_T *m)
+{
+  /* UNION (A, B, A) -> UNION (A, B).  */
+  for (; m != NO_MOID; FORWARD (m))
+    {
+      if (IS (m, UNION_SYMBOL) && EQUIVALENT (m) == NO_MOID)
+	a68_contract_union (m);
+    }
+}
+
+/*
+ * Routines to collect MOIDs from the program text.
+ */
+
+/* Search standard mode in standard environ.  */
+
+static MOID_T *
+search_standard_mode (int sizety, NODE_T *indicant)
+{
+  /* Search standard mode.  */
+  for (MOID_T *p = TOP_MOID (&A68_JOB); p != NO_MOID; FORWARD (p))
+    {
+      if (IS (p, STANDARD)
+	  && DIM (p) == sizety
+	  && NSYMBOL (NODE (p)) == NSYMBOL (indicant))
+	return p;
+  }
+
+  /* Map onto greater precision.  */
+  if (sizety < 0)
+    return search_standard_mode (sizety + 1, indicant);
+  else if (sizety > 0)
+    return search_standard_mode (sizety - 1, indicant);
+  else
+    return NO_MOID;
+}
+
+/* Collect mode from STRUCT field.  */
+
+static void
+get_mode_from_struct_field (NODE_T *p, PACK_T **u)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, IDENTIFIER))
+	{
+	  ATTRIBUTE (p) = FIELD_IDENTIFIER;
+	  (void) a68_add_mode_to_pack (u, NO_MOID, NSYMBOL (p), p);
+	}
+      else if (IS (p, DECLARER))
+	{
+	  MOID_T *new_one = get_mode_from_declarer (p);
+
+	  get_mode_from_struct_field (NEXT (p), u);
+	  for (PACK_T *t = *u; t && MOID (t) == NO_MOID; FORWARD (t))
+	    {
+	      MOID (t) = new_one;
+	      MOID (NODE (t)) = new_one;
+	    }
+	}
+      else
+	{
+	  get_mode_from_struct_field (NEXT (p), u);
+	  get_mode_from_struct_field (SUB (p), u);
+	}
+    }
+}
+
+/* Collect MODE from formal pack.  */
+
+static void
+get_mode_from_formal_pack (NODE_T *p, PACK_T **u)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, DECLARER))
+	{
+	  get_mode_from_formal_pack (NEXT (p), u);
+	  MOID_T *z = get_mode_from_declarer (p);
+	  (void) a68_add_mode_to_pack (u, z, NO_TEXT, p);
+	}
+      else
+	{
+	  get_mode_from_formal_pack (NEXT (p), u);
+	  get_mode_from_formal_pack (SUB (p), u);
+	}
+    }
+}
+
+/* Collect MODE or VOID from formal UNION pack.  */
+
+static void
+get_mode_from_union_pack (NODE_T *p, PACK_T **u)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, DECLARER) || IS (p, VOID_SYMBOL))
+	{
+	  get_mode_from_union_pack (NEXT (p), u);
+	  MOID_T *z = get_mode_from_declarer (p);
+	  (void) a68_add_mode_to_pack (u, z, NO_TEXT, p);
+	}
+      else
+	{
+	  get_mode_from_union_pack (NEXT (p), u);
+	  get_mode_from_union_pack (SUB (p), u);
+	}
+    }
+}
+
+/* Collect mode from PROC, OP pack.  */
+
+static void
+get_mode_from_routine_pack (NODE_T *p, PACK_T **u)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, IDENTIFIER))
+	(void) a68_add_mode_to_pack (u, NO_MOID, NO_TEXT, p);
+      else if (IS (p, DECLARER))
+	{
+	  MOID_T *z = get_mode_from_declarer (p);
+
+	  for (PACK_T *t = *u; t != NO_PACK && MOID (t) == NO_MOID; FORWARD (t))
+	    {
+	      MOID (t) = z;
+	      MOID (NODE (t)) = z;
+	    }
+	  (void) a68_add_mode_to_pack (u, z, NO_TEXT, p);
+	}
+      else
+	{
+	  get_mode_from_routine_pack (NEXT (p), u);
+	  get_mode_from_routine_pack (SUB (p), u);
+	}
+    }
+}
+
+/* Collect MODE from DECLARER.  */
+
+static MOID_T *
+get_mode_from_declarer (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return NO_MOID;
+  else
+    {
+      if (IS (p, DECLARER))
+	{
+	  if (MOID (p) != NO_MOID)
+	    return MOID (p);
+	 else
+	   return MOID (p) = get_mode_from_declarer (SUB (p));
+	}
+      else
+	{
+	  if (IS (p, VOID_SYMBOL))
+	    {
+	      MOID (p) = M_VOID;
+	      return MOID (p);
+	    }
+	  else if (IS (p, LONGETY))
+	    {
+	      if (a68_whether (p, LONGETY, INDICANT, STOP))
+		{
+		  int k = count_sizety (SUB (p));
+		  MOID (p) = search_standard_mode (k, NEXT (p));
+		  return MOID (p);
+		}
+	      else
+		{
+		  return NO_MOID;
+		}
+	    }
+	  else if (IS (p, SHORTETY))
+	    {
+	      if (a68_whether (p, SHORTETY, INDICANT, STOP))
+		{
+		  int k = count_sizety (SUB (p));
+		  MOID (p) = search_standard_mode (k, NEXT (p));
+		  return MOID (p);
+		}
+	      else
+		return NO_MOID;
+	    }
+	  else if (IS (p, INDICANT))
+	    {
+	      MOID_T *q = search_standard_mode (0, p);
+	      if (q != NO_MOID)
+		  MOID (p) = q;
+	      else
+		{
+		  /* Position of definition tells indicants apart.  */
+		  TAG_T *y = a68_find_tag_global (TABLE (p), INDICANT, NSYMBOL (p));
+		  if (y == NO_TAG)
+		    a68_error ( p, "tag Z has not been declared properly", NSYMBOL (p));
+		  else
+		    MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB), INDICANT, 0, NODE (y),
+					     NO_MOID, NO_PACK);
+		}
+	      return MOID (p);
+	    }
+	  else if (IS_REF (p))
+	    {
+	      MOID_T *new_one = get_mode_from_declarer (NEXT (p));
+	      MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, p, new_one, NO_PACK);
+	      return MOID (p);
+	    }
+	  else if (IS_FLEX (p))
+	    {
+	      MOID_T *new_one = get_mode_from_declarer (NEXT (p));
+	      MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB), FLEX_SYMBOL, 0, p, new_one, NO_PACK);
+	      SLICE (MOID (p)) = SLICE (new_one);
+	      return MOID (p);
+	    }
+	  else if (IS (p, FORMAL_BOUNDS))
+	    {
+	      MOID_T *new_one = get_mode_from_declarer (NEXT (p));
+	      MOID (p) = add_row (&TOP_MOID (&A68_JOB),
+				  1 + a68_count_formal_bounds (SUB (p)), new_one, p, false);
+	      return MOID (p);
+	    }
+	  else if (IS (p, BOUNDS))
+	    {
+	      MOID_T *new_one = get_mode_from_declarer (NEXT (p));
+	      MOID (p) = add_row (&TOP_MOID (&A68_JOB), count_bounds (SUB (p)), new_one, p, false);
+	      return MOID (p);
+	    }
+	  else if (IS (p, STRUCT_SYMBOL))
+	    {
+	      PACK_T *u = NO_PACK;
+	      get_mode_from_struct_field (NEXT (p), &u);
+	      MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB),
+				       STRUCT_SYMBOL, a68_count_pack_members (u), p, NO_MOID, u);
+	      return MOID (p);
+	    }
+	  else if (IS (p, UNION_SYMBOL))
+	    {
+	      PACK_T *u = NO_PACK;
+	      get_mode_from_union_pack (NEXT (p), &u);
+	      MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB),
+				       UNION_SYMBOL, a68_count_pack_members (u), p, NO_MOID, u);
+	      return MOID (p);
+	    }
+	  else if (IS (p, PROC_SYMBOL))
+	    {
+	      NODE_T *save = p;
+	      PACK_T *u = NO_PACK;
+	      if (IS (NEXT (p), FORMAL_DECLARERS))
+		{
+		  get_mode_from_formal_pack (SUB_NEXT (p), &u);
+		  FORWARD (p);
+		}
+	      MOID_T *new_one = get_mode_from_declarer (NEXT (p));
+	      MOID (p) =
+		a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (u), save, new_one, u);
+	      MOID (save) = MOID (p);
+	      return MOID (p);
+	    }
+	  else
+	    return NO_MOID;
+	}
+    }
+}
+
+/* Collect MODEs from a routine-text header.  */
+
+static MOID_T *
+get_mode_from_routine_text (NODE_T *p)
+{
+  PACK_T *u = NO_PACK;
+  NODE_T *q = p;
+
+  if (IS (p, PARAMETER_PACK))
+    {
+      get_mode_from_routine_pack (SUB (p), &u);
+      FORWARD (p);
+    }
+  MOID_T *n = get_mode_from_declarer (p);
+  return a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (u), q, n, u);
+}
+
+/* Collect modes from operator-plan.  */
+
+static MOID_T *
+get_mode_from_operator (NODE_T *p)
+{
+  PACK_T *u = NO_PACK;
+  NODE_T *save = p;
+
+  if (IS (NEXT (p), FORMAL_DECLARERS))
+    {
+      get_mode_from_formal_pack (SUB_NEXT (p), &u);
+      FORWARD (p);
+    }
+  MOID_T *new_one = get_mode_from_declarer (NEXT (p));
+  MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (u), save, new_one, u);
+  return MOID (p);
+}
+
+/* Collect mode from denotation.  */
+
+static void
+get_mode_from_denotation (NODE_T *p, int sizety)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, ROW_CHAR_DENOTATION))
+	{
+	  const char *s = NSYMBOL (p);
+	  size_t len = strlen (s);
+
+	  if (len == 1
+	      || (len == 2 && s[0] == '\'')
+	      || (len == 8 && s[0] == '\'' && s[1] == '(' && s[2] == 'u')
+	      || (len == 12 && s[0] == '\'' && s[1] == '(' && s[2] == 'U'))
+	    {
+	      /* XXX check that character value is in range.  */
+	      MOID (p) = M_CHAR;
+	    }
+	  else
+	    MOID (p) = M_ROW_CHAR;
+	}
+      else if (IS (p, TRUE_SYMBOL) || IS (p, FALSE_SYMBOL))
+	{
+	  MOID (p) = M_BOOL;
+	}
+      else if (IS (p, INT_DENOTATION))
+	{
+	  if (sizety == -2)
+	    MOID (p) = M_SHORT_SHORT_INT;
+	  else if (sizety == -1)
+	    MOID (p) = M_SHORT_INT;
+	  else if (sizety == 0)
+	    MOID (p) = M_INT;
+	  else if (sizety == 1)
+	    MOID (p) = M_LONG_INT;
+	  else if (sizety == 2)
+	    MOID (p) = M_LONG_LONG_INT;
+	 else
+	   MOID (p) = (sizety > 0 ? M_LONG_LONG_INT : M_INT);
+	}
+      else if (IS (p, REAL_DENOTATION))
+	{
+	  if (sizety == 0)
+	    MOID (p) = M_REAL;
+	  else if (sizety == 1)
+	    MOID (p) = M_LONG_REAL;
+	 else if (sizety == 2)
+	   MOID (p) = M_LONG_LONG_REAL;
+	 else
+	   MOID (p) = (sizety > 0 ? M_LONG_LONG_REAL : M_REAL);
+	}
+      else if (IS (p, BITS_DENOTATION))
+	{
+	  if (sizety == -2)
+	    MOID (p) = M_SHORT_SHORT_BITS;
+	  else if (sizety == -1)
+	    MOID (p) = M_SHORT_BITS;
+	  else if (sizety == 0)
+	    MOID (p) = M_BITS;
+	  else if (sizety == 1)
+	    MOID (p) = M_LONG_BITS;
+	  else if (sizety == 2)
+	    MOID (p) = M_LONG_LONG_BITS;
+	  else
+	    MOID (p) = (sizety > 0 ? M_LONG_LONG_BITS : M_BITS);
+	}
+      else if (IS (p, LONGETY) || IS (p, SHORTETY))
+	{
+	  get_mode_from_denotation (NEXT (p), count_sizety (SUB (p)));
+	  MOID (p) = MOID (NEXT (p));
+	}
+      else if (IS (p, EMPTY_SYMBOL))
+       {
+	 MOID (p) = M_VOID;
+       }
+    }
+}
+
+/* Collect modes from the syntax tree.  */
+
+static void
+get_modes_from_tree (NODE_T *p, int attribute)
+{
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (IS (q, VOID_SYMBOL))
+	MOID (q) = M_VOID;
+      else if (IS (q, DECLARER))
+	{
+	  if (attribute == VARIABLE_DECLARATION)
+	    {
+	      MOID_T *new_one = get_mode_from_declarer (q);
+	      MOID (q) = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, new_one, NO_PACK);
+	    }
+	  else
+	    MOID (q) = get_mode_from_declarer (q);
+	}
+      else if (IS (q, ROUTINE_TEXT))
+	{
+	  MOID (q) = get_mode_from_routine_text (SUB (q));
+	}
+      else if (IS (q, OPERATOR_PLAN))
+	{
+	  MOID (q) = get_mode_from_operator (SUB (q));
+	}
+      else if (a68_is_one_of (q, LOC_SYMBOL, HEAP_SYMBOL, STOP))
+	{
+	  if (attribute == GENERATOR)
+	    {
+	      MOID_T *new_one = get_mode_from_declarer (NEXT (q));
+	      MOID (NEXT (q)) = new_one;
+	      MOID (q) = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, new_one, NO_PACK);
+	    }
+	}
+      else
+	{
+	  if (attribute == DENOTATION)
+	    get_mode_from_denotation (q, 0);
+	}
+    }
+
+  if (attribute != DENOTATION)
+    {
+      for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+	{
+	  if (SUB (q) != NO_NODE)
+	    get_modes_from_tree (SUB (q), ATTRIBUTE (q));
+	}
+    }
+}
+
+//! @brief Collect modes from proc variables.
+
+static void
+get_mode_from_proc_variables (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, PROCEDURE_VARIABLE_DECLARATION))
+	{
+	  get_mode_from_proc_variables (SUB (p));
+	  get_mode_from_proc_variables (NEXT (p));
+	}
+      else if (IS (p, QUALIFIER) || IS (p, PROC_SYMBOL) || IS (p, COMMA_SYMBOL))
+	{
+	  get_mode_from_proc_variables (NEXT (p));
+	}
+      else if (IS (p, DEFINING_IDENTIFIER))
+	{
+	  MOID_T *new_one = MOID (NEXT_NEXT (p));
+	  MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, p, new_one, NO_PACK);
+	}
+    }
+}
+
+/* Collect modes from proc variable declarations.  */
+
+static void
+get_mode_from_proc_var_declarations_tree (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      get_mode_from_proc_var_declarations_tree (SUB (p));
+
+      if (IS (p, PROCEDURE_VARIABLE_DECLARATION))
+	get_mode_from_proc_variables (p);
+    }
+}
+
+/*
+ * Various routines to test modes.
+ */
+
+/* Whether a mode declaration refers to self or relates to void.
+   This uses Lindsey's ying-yang algorithm.  */
+
+static bool
+is_well_formed (MOID_T *def, MOID_T *z, bool yin, bool yang, bool video)
+{
+  if (z == NO_MOID)
+    return false;
+  else if (yin && yang)
+    return z == M_VOID ? video : true;
+  else if (z == M_VOID)
+    return video;
+  else if (IS (z, STANDARD))
+    return true;
+  else if (IS (z, INDICANT))
+    {
+      if (def == NO_MOID)
+	{
+	  /* Check an applied indicant for relation to VOID.  */
+	  while (z != NO_MOID)
+	    z = EQUIVALENT (z);
+	  if (z == M_VOID)
+	    return video;
+	  else
+	    return true;
+	}
+      else
+	{
+	  if (z == def || USE (z))
+	    return yin && yang;
+	  else
+	    {
+	      USE (z) = true;
+	      bool wwf = is_well_formed (def, EQUIVALENT (z), yin, yang, video);
+	      USE (z) = false;
+	  return wwf;
+	    }
+	}
+    }
+  else if (IS_REF (z))
+    return is_well_formed (def, SUB (z), true, yang, false);
+  else if (IS (z, PROC_SYMBOL))
+    return PACK (z) != NO_PACK ? true : is_well_formed (def, SUB (z), true, yang, true);
+  else if (IS_ROW (z))
+    return is_well_formed (def, SUB (z), yin, yang, false);
+  else if (IS_FLEX (z))
+    return is_well_formed (def, SUB (z), yin, yang, false);
+  else if (IS (z, STRUCT_SYMBOL))
+    {
+      for (PACK_T *s = PACK (z); s != NO_PACK; FORWARD (s))
+	{
+	  if (!is_well_formed (def, MOID (s), yin, true, false))
+	    return false;
+	}
+      return true;
+    }
+  else if (IS (z, UNION_SYMBOL))
+    {
+      for (PACK_T *s = PACK (z); s != NO_PACK; FORWARD (s))
+	{
+	  if (!is_well_formed (def, MOID (s), yin, yang, true))
+	    return false;
+	}
+      return true;
+    }
+  else
+    {
+      return false;
+    }
+}
+
+/* Replace a mode by its equivalent mode (walk chain).  */
+
+static void
+resolve_eq_members (MOID_T *q)
+{
+  resolve_equivalent (&SUB (q));
+  resolve_equivalent (&DEFLEXED (q));
+  resolve_equivalent (&MULTIPLE (q));
+  resolve_equivalent (&NAME (q));
+  resolve_equivalent (&SLICE (q));
+  resolve_equivalent (&TRIM (q));
+  resolve_equivalent (&ROWED (q));
+  for (PACK_T *p = PACK (q); p != NO_PACK; FORWARD (p))
+    resolve_equivalent (&MOID (p));
+}
+
+/* Track equivalent tags.  */
+
+static void
+resolve_eq_tags (TAG_T *z)
+{
+  for (; z != NO_TAG; FORWARD (z))
+    {
+      if (MOID (z) != NO_MOID)
+	resolve_equivalent (&MOID (z));
+    }
+}
+
+/* Bind modes in syntax tree.  */
+
+static void
+bind_modes (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      resolve_equivalent (&MOID (p));
+
+      if (SUB (p) != NO_NODE && a68_is_new_lexical_level (p))
+	{
+	  TABLE_T *s = TABLE (SUB (p));
+	  for (TAG_T *z = INDICANTS (s); z != NO_TAG; FORWARD (z))
+	    {
+	      if (NODE (z) != NO_NODE)
+		{
+		  resolve_equivalent (&MOID (NEXT_NEXT (NODE (z))));
+		  MOID (z) = MOID (NEXT_NEXT (NODE (z)));
+		  MOID (NODE (z)) = MOID (z);
+		}
+	    }
+	}
+      bind_modes (SUB (p));
+    }
+}
+
+/* Routines for calculating subordinates for selections, for instance selection
+   from REF STRUCT (A) yields REF A fields and selection from [] STRUCT (A)
+   yields [] A fields.  */
+
+/* Make name pack.
+   Given a pack with modes: M1, M2, ...
+   Build a pack with modes: REF M1, REF M2, ...  */
+
+static void
+make_name_pack (PACK_T *src, PACK_T **dst, MOID_T **p)
+{
+  if (src != NO_PACK)
+    {
+      make_name_pack (NEXT (src), dst, p);
+      MOID_T *z = a68_add_mode (p, REF_SYMBOL, 0, NO_NODE, MOID (src), NO_PACK);
+      (void) a68_add_mode_to_pack (dst, z, TEXT (src), NODE (src));
+    }
+}
+
+/* Make flex multiple row pack.
+   Given a pack with modes: M1, M2, ...
+   Build a pack with modes: []M1, []M2, ...  */
+
+static void
+make_flex_multiple_row_pack (PACK_T *src, PACK_T **dst, MOID_T **p, int dim)
+{
+  if (src != NO_PACK)
+    {
+      make_flex_multiple_row_pack (NEXT (src), dst, p, dim);
+      MOID_T *z = add_row (p, dim, MOID (src), NO_NODE, false);
+      z = a68_add_mode (p, FLEX_SYMBOL, 0, NO_NODE, z, NO_PACK);
+      (void) a68_add_mode_to_pack (dst, z, TEXT (src), NODE (src));
+    }
+}
+
+/* Make name struct.  */
+
+static MOID_T *
+make_name_struct (MOID_T *m, MOID_T **p)
+{
+  PACK_T *u = NO_PACK;
+  make_name_pack (PACK (m), &u, p);
+  return a68_add_mode (p, STRUCT_SYMBOL, DIM (m), NO_NODE, NO_MOID, u);
+}
+
+/* Make name row.  */
+
+static MOID_T *
+make_name_row (MOID_T *m, MOID_T **p)
+{
+  if (SLICE (m) != NO_MOID)
+    return a68_add_mode (p, REF_SYMBOL, 0, NO_NODE, SLICE (m), NO_PACK);
+  else if (SUB (m) != NO_MOID)
+    return a68_add_mode (p, REF_SYMBOL, 0, NO_NODE, SUB (m), NO_PACK);
+  else
+    /* weird, FLEX INT or so ...  */
+    return NO_MOID;
+}
+
+/* Make multiple row pack.  */
+
+static void
+make_multiple_row_pack (PACK_T *src, PACK_T **dst, MOID_T **p, int dim)
+{
+  if (src != NO_PACK)
+    {
+      make_multiple_row_pack (NEXT (src), dst, p, dim);
+      (void) a68_add_mode_to_pack (dst, add_row (p, dim, MOID (src), NO_NODE, false),
+				   TEXT (src), NODE (src));
+    }
+}
+
+/* Make flex multiple struct.  */
+
+static MOID_T *
+make_flex_multiple_struct (MOID_T *m, MOID_T **p, int dim)
+{
+  PACK_T *u = NO_PACK;
+  make_flex_multiple_row_pack (PACK (m), &u, p, dim);
+  return a68_add_mode (p, STRUCT_SYMBOL, DIM (m), NO_NODE, NO_MOID, u);
+}
+
+/* Make multiple struct.  */
+
+static MOID_T *
+make_multiple_struct (MOID_T *m, MOID_T **p, int dim)
+{
+  PACK_T *u = NO_PACK;
+  make_multiple_row_pack (PACK (m), &u, p, dim);
+  return a68_add_mode (p, STRUCT_SYMBOL, DIM (m), NO_NODE, NO_MOID, u);
+}
+
+/* Whether mode has row.  */
+
+static bool
+is_mode_has_row (MOID_T *m)
+{
+  if (IS (m, STRUCT_SYMBOL) || IS (m, UNION_SYMBOL))
+    {
+      bool k = false;
+
+      for (PACK_T *p = PACK (m); p != NO_PACK && k == false; FORWARD (p))
+	{
+	  HAS_ROWS (MOID (p)) = is_mode_has_row (MOID (p));
+	  k |= (HAS_ROWS (MOID (p)));
+	}
+      return k;
+    }
+  else
+    return (HAS_ROWS (m) || IS_ROW (m) || IS_FLEX (m));
+}
+
+/* Compute derived modes.  */
+
+static void
+compute_derived_modes (MODULE_T *mod)
+{
+  MOID_T *z;
+  int len = 0, nlen = 1;
+
+  /* UNION things.  */
+  absorb_unions (TOP_MOID (mod));
+  contract_unions (TOP_MOID (mod));
+  /* The for-statement below prevents an endless loop.  */
+  for (int k = 1; k <= 10 && len != nlen; k++)
+    {
+      /* Make deflexed modes.  */
+      for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+	{
+	  if (SUB (z) != NO_MOID)
+	    {
+	      if (IS_REF_FLEX (z) && DEFLEXED (SUB_SUB (z)) != NO_MOID)
+		DEFLEXED (z) = a68_add_mode (&TOP_MOID (mod), REF_SYMBOL, 0, NODE (z),
+					     DEFLEXED (SUB_SUB (z)), NO_PACK);
+	      else if (IS_REF (z) && DEFLEXED (SUB (z)) != NO_MOID)
+		DEFLEXED (z) = a68_add_mode (&TOP_MOID (mod), REF_SYMBOL, 0, NODE (z),
+					     DEFLEXED (SUB (z)), NO_PACK);
+	      else if (IS_ROW (z) && DEFLEXED (SUB (z)) != NO_MOID)
+		DEFLEXED (z) = a68_add_mode (&TOP_MOID (mod), ROW_SYMBOL, DIM (z), NODE (z),
+					     DEFLEXED (SUB (z)), NO_PACK);
+	      else if (IS_FLEX (z) && DEFLEXED (SUB (z)) != NO_MOID)
+		DEFLEXED (z) = DEFLEXED (SUB (z));
+	      else if (IS_FLEX (z))
+		DEFLEXED (z) = SUB (z);
+	      else
+		DEFLEXED (z) = z;
+	    }
+	}
+
+      /* Derived modes for stowed modes.  */
+      for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+	{
+	  if (NAME (z) == NO_MOID && IS_REF (z))
+	    {
+	      if (IS (SUB (z), STRUCT_SYMBOL))
+		NAME (z) = make_name_struct (SUB (z), &TOP_MOID (mod));
+	      else if (IS_ROW (SUB (z)))
+		NAME (z) = make_name_row (SUB (z), &TOP_MOID (mod));
+	      else if (IS_FLEX (SUB (z)) && SUB_SUB (z) != NO_MOID)
+		NAME (z) = make_name_row (SUB_SUB (z), &TOP_MOID (mod));
+	    }
+
+	  if (MULTIPLE (z) != NO_MOID)
+	    ;
+	  else if (IS_REF (z))
+	    {
+	      if (MULTIPLE (SUB (z)) != NO_MOID)
+		MULTIPLE (z) = make_name_struct (MULTIPLE (SUB (z)), &TOP_MOID (mod));
+	    }
+	  else if (IS_ROW (z))
+	    {
+	      if (IS (SUB (z), STRUCT_SYMBOL))
+		MULTIPLE (z) = make_multiple_struct (SUB (z), &TOP_MOID (mod), DIM (z));
+	    }
+	}
+
+      for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+	{
+	  if (TRIM (z) == NO_MOID && IS_FLEX (z))
+	    TRIM (z) = SUB (z);
+	  if (TRIM (z) == NO_MOID && IS_REF_FLEX (z))
+	    TRIM (z) = a68_add_mode (&TOP_MOID (mod), REF_SYMBOL, 0, NODE (z), SUB_SUB (z), NO_PACK);
+	}
+
+      /* Fill out stuff for rows, f.i. inverse relations.  */
+      for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+	{
+	  if (IS_ROW (z) && DIM (z) > 0 && SUB (z) != NO_MOID && !DERIVATE (z))
+	    (void) add_row (&TOP_MOID (mod), DIM (z) + 1, SUB (z), NODE (z), true);
+	  else if (IS_REF (z) && IS (SUB (z), ROW_SYMBOL) && !DERIVATE (SUB (z)))
+	    {
+	      MOID_T *x = add_row (&TOP_MOID (mod), DIM (SUB (z)) + 1, SUB_SUB (z), NODE (SUB (z)), true);
+	      MOID_T *y = a68_add_mode (&TOP_MOID (mod), REF_SYMBOL, 0, NODE (z), x, NO_PACK);
+	      NAME (y) = z;
+	    }
+	}
+
+      for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+	{
+	  if (IS_ROW (z) && SLICE (z) != NO_MOID)
+	    ROWED (SLICE (z)) = z;
+	  if (IS_REF (z))
+	    {
+	      MOID_T *y = SUB (z);
+	      if (SLICE (y) != NO_MOID && IS_ROW (SLICE (y)) && NAME (z) != NO_MOID)
+		ROWED (NAME (z)) = z;
+	    }
+	}
+
+      bind_modes (TOP_NODE (mod));
+      for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+	{
+	  if (IS (z, INDICANT) && NODE (z) != NO_NODE)
+	    EQUIVALENT (z) = MOID (NODE (z));
+	}
+      for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+	resolve_eq_members (z);
+      resolve_eq_tags (INDICANTS (A68_STANDENV));
+      resolve_eq_tags (IDENTIFIERS (A68_STANDENV));
+      resolve_eq_tags (OPERATORS (A68_STANDENV));
+      resolve_equivalent (&M_STRING);
+      resolve_equivalent (&M_COMPLEX);
+      resolve_equivalent (&M_LONG_COMPLEX);
+      resolve_equivalent (&M_LONG_LONG_COMPLEX);
+      resolve_equivalent (&M_SEMA);
+      /* UNION members could be resolved.  */
+      absorb_unions (TOP_MOID (mod));
+      contract_unions (TOP_MOID (mod));
+      /* FLEX INDICANT could be resolved.  */
+      for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+	{
+	  if (IS_FLEX (z) && SUB (z) != NO_MOID)
+	    {
+	      if (SUB_SUB (z) != NO_MOID && IS (SUB_SUB (z), STRUCT_SYMBOL))
+		MULTIPLE (z) = make_flex_multiple_struct (SUB_SUB (z), &TOP_MOID (mod), DIM (SUB (z)));
+	    }
+	}
+      /* See what new known modes we have generated by resolving..  */
+      for (z = TOP_MOID (mod); z != STANDENV_MOID (&A68_JOB); FORWARD (z))
+	{
+	  MOID_T *v;
+
+	  for (v = NEXT (z); v != NO_MOID; FORWARD (v))
+	    {
+	      if (a68_prove_moid_equivalence (z, v))
+		{
+		  EQUIVALENT (z) = v;
+		  EQUIVALENT (v) = NO_MOID;
+		}
+	    }
+	}
+
+      /* Count the modes to check self consistency.  */
+      len = nlen;
+      for (nlen = 0, z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+	nlen++;
+    }
+
+  gcc_assert (M_STRING == M_FLEX_ROW_CHAR);
+
+  /* Find out what modes contain rows.  */
+  for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+    HAS_ROWS (z) = is_mode_has_row (z);
+
+  /* Check flexible modes.  */
+  for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+    {
+      if (IS_FLEX (z) && !IS (SUB (z), ROW_SYMBOL))
+	a68_error (NODE (z), "M does not specify a well formed mode", z);
+    }
+
+  /* Check on fields in structured modes f.i. STRUCT (REAL x, INT n, REAL x) is
+     wrong.  */
+  for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+    {
+      if (IS (z, STRUCT_SYMBOL) && EQUIVALENT (z) == NO_MOID)
+	{
+	  PACK_T *s = PACK (z);
+
+	  for (; s != NO_PACK; FORWARD (s))
+	    {
+	      PACK_T *t = NEXT (s);
+	      bool x = true;
+
+	      for (t = NEXT (s); t != NO_PACK && x; FORWARD (t))
+		{
+		  if (TEXT (s) == TEXT (t))
+		    {
+		      a68_error (NODE (z), "multiple declaration of field S");
+		      while (NEXT (s) != NO_PACK && TEXT (NEXT (s)) == TEXT (t))
+			FORWARD (s);
+		      x = false;
+		    }
+		}
+	    }
+	}
+    }
+
+  /* Various union test.  */
+  for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+    {
+      if (IS (z, UNION_SYMBOL) && EQUIVALENT (z) == NO_MOID)
+	{
+	  PACK_T *s = PACK (z);
+	  /* Discard unions with one member.  */
+	  if (a68_count_pack_members (s) == 1)
+	    a68_error (NODE (z), "M must have at least two components", z);
+	  /* Discard incestuous unions with firmly related modes.  */
+	  for (; s != NO_PACK; FORWARD (s))
+	    {
+	      PACK_T *t;
+
+	      for (t = NEXT (s); t != NO_PACK; FORWARD (t))
+		{
+		  if (MOID (t) != MOID (s))
+		    {
+		      if (a68_is_firm (MOID (s), MOID (t)))
+			a68_error (NODE (z), "M has firmly related components", z);
+		    }
+		}
+	    }
+
+	  /* Discard incestuous unions with firmly related subsets.  */
+	  for (s = PACK (z); s != NO_PACK; FORWARD (s))
+	    {
+	      MOID_T *n = a68_depref_completely (MOID (s));
+
+	      if (IS (n, UNION_SYMBOL) && a68_is_subset (n, z, NO_DEFLEXING))
+		  a68_error (NODE (z), "M has firmly related subset M", z, n);
+	    }
+	}
+    }
+
+  /* Wrap up and exit.  */
+  a68_free_postulate_list (A68 (top_postulate), NO_POSTULATE);
+  A68 (top_postulate) = NO_POSTULATE;
+}
+
+/* Make list of all modes in the program.  */
+
+void
+a68_make_moid_list (MODULE_T *mod)
+{
+  bool cont = true;
+
+  /* Collect modes from the syntax tree.  */
+  reset_moid_tree (TOP_NODE (mod));
+  get_modes_from_tree (TOP_NODE (mod), STOP);
+  get_mode_from_proc_var_declarations_tree (TOP_NODE (mod));
+
+  /* Connect indicants to their declarers.  */
+  for (MOID_T *z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+    {
+      if (IS (z, INDICANT))
+	{
+	  NODE_T *u = NODE (z);
+	  gcc_assert (NEXT (u) != NO_NODE);
+	  gcc_assert (NEXT_NEXT (u) != NO_NODE);
+	  gcc_assert (MOID (NEXT_NEXT (u)) != NO_MOID);
+	  EQUIVALENT (z) = MOID (NEXT_NEXT (u));
+	}
+    }
+
+  /* Checks on wrong declarations.  */
+  for (MOID_T *z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+    USE (z) = false;
+
+  for (MOID_T *z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+    {
+      if (IS (z, INDICANT) && EQUIVALENT (z) != NO_MOID)
+	{
+	  if (!is_well_formed (z, EQUIVALENT (z), false, false, true))
+	    {
+	      a68_error (NODE (z), "M does not specify a well formed mode", z);
+	      cont = false;
+	    }
+	}
+    }
+
+  for (MOID_T *z = TOP_MOID (mod); cont && z != NO_MOID; FORWARD (z))
+    {
+      if (IS (z, INDICANT) && EQUIVALENT (z) != NO_MOID)
+	;
+      else if (NODE (z) != NO_NODE)
+	{
+	  if (!is_well_formed (NO_MOID, z, false, false, true))
+	    a68_error (NODE (z), "M does not specify a well formed mode", z);
+	}
+    }
+
+  for (MOID_T *z = TOP_MOID (mod); z != NO_MOID; FORWARD (z))
+    {
+      if (USE (z))
+	gcc_unreachable ();
+    }
+
+  if (ERROR_COUNT (mod) != 0)
+    return;
+
+  compute_derived_modes (mod);
+  a68_init_postulates ();
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-moids-check.cc
@@ -0,0 +1,1810 @@
+/* Mode checker routines.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC and fixes by Jose E. Marchesi.
+
+   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/>.  */
+
+/* ALGOL 68 contexts are SOFT, WEAK, MEEK, FIRM and STRONG.
+   These contexts are increasing in strength:
+
+   SOFT: Deproceduring
+
+   WEAK: Dereferencing to REF [] or REF STRUCT
+
+   MEEK: Deproceduring and dereferencing
+
+   FIRM: MEEK followed by uniting
+
+   STRONG: FIRM followed by rowing, widening or voiding
+
+   Furthermore you will see in this file next switches:
+
+   (1) FORCE_DEFLEXING allows assignment compatibility between FLEX and non FLEX
+   rows. This can only be the case when there is no danger of altering bounds of a
+   non FLEX row.
+
+   (2) ALIAS_DEFLEXING prohibits aliasing a FLEX row to a non FLEX row (vice versa
+   is no problem) so that one cannot alter the bounds of a non FLEX row by
+   aliasing it to a FLEX row. This is particularly the case when passing names as
+   parameters to procedures:
+
+      PROC x = (REF STRING s) VOID: ..., PROC y = (REF [] CHAR c) VOID: ...;
+
+      x (LOC STRING);    # OK #
+
+      x (LOC [10] CHAR); # Not OK, suppose x changes bounds of s! #
+
+      y (LOC STRING);    # OK #
+
+      y (LOC [10] CHAR); # OK #
+
+   (3) SAFE_DEFLEXING sets FLEX row apart from non FLEX row. This holds for names,
+   not for values, so common things are not rejected, for instance
+
+      STRING x = read string;
+
+      [] CHAR y = read string
+
+   (4) NO_DEFLEXING sets FLEX row apart from non FLEX row.  */
+
+/*
+  In the RR grammar:
+
+     SORT: strong; firm; weak; meek; soft.
+     SORT MOID serial clause;
+       strong void unit, go on token, SORT MOID serial clause;
+       declaration, go on token, SORT MOID serial clause;
+       SORT MOID unit
+
+  And it is the SORT MOID sequence of metanotions, which shall evaluate the
+  same in the complete rule, that control the balancing! o_O
+
+  Also, it denotes how the SORT MOID of the serial clause gets "passed" to the
+  last unit in the serial clause.  Other units have SOID `strong void'.
+
+  It is used to pass down the required mode on whatever context.  Like,
+  PARTICULAR_PROGRAM evaluates in strong context and requires VOID.
+
+  The ATTRIBUTE in the soid is used to pass down the kind of construct that
+  introduces the context+required mode.  This is used in
+  a68_determine_unique_mode in order to know whether balancing shall be
+  performed or not.
+*/
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "options.h"
+
+#include "a68.h"
+
+/* Forward declarations of some of the functions defined below.  */
+
+static void mode_check_enclosed (NODE_T *p, SOID_T *x, SOID_T *y);
+static void mode_check_unit (NODE_T *p, SOID_T *x, SOID_T *y);
+static void mode_check_formula (NODE_T *p, SOID_T *x, SOID_T *y);
+
+/* Driver for mode checker.  */
+
+void
+a68_mode_checker (NODE_T *p)
+{
+  if (IS (p, PARTICULAR_PROGRAM))
+    {
+      A68 (top_soid_list) = NO_SOID;
+      SOID_T x, y;
+      a68_make_soid (&x, STRONG, M_VOID, 0);
+      mode_check_enclosed (SUB (p), &x, &y);
+      MOID (p) = MOID (&y);
+    }
+}
+
+/* Mode check on bounds.  */
+
+static void
+mode_check_bounds (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, UNIT))
+    {
+      SOID_T x, y;
+      a68_make_soid (&x, STRONG, M_INT, 0);
+      mode_check_unit (p, &x, &y);
+      if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING))
+	a68_cannot_coerce (p, MOID (&y), M_INT, MEEK, SAFE_DEFLEXING, UNIT);
+      mode_check_bounds (NEXT (p));
+    }
+  else
+    {
+      mode_check_bounds (SUB (p));
+      mode_check_bounds (NEXT (p));
+    }
+}
+
+/* Mode check declarer.  */
+
+static void
+mode_check_declarer (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, BOUNDS))
+    {
+      mode_check_bounds (SUB (p));
+      mode_check_declarer (NEXT (p));
+    }
+  else
+    {
+      mode_check_declarer (SUB (p));
+      mode_check_declarer (NEXT (p));
+    }
+}
+
+/* Mode check identity declaration.  */
+
+static void
+mode_check_identity_declaration (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      switch (ATTRIBUTE (p))
+	{
+	case DECLARER:
+	  mode_check_declarer (SUB (p));
+	  mode_check_identity_declaration (NEXT (p));
+	  break;
+	case DEFINING_IDENTIFIER:
+	  {
+	    SOID_T x, y;
+	    a68_make_soid (&x, STRONG, MOID (p), 0);
+	    mode_check_unit (NEXT_NEXT (p), &x, &y);
+	    if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING))
+	      a68_cannot_coerce (NEXT_NEXT (p), MOID (&y), MOID (&x), STRONG, SAFE_DEFLEXING, UNIT);
+	    else if (MOID (&x) != MOID (&y))
+	      /* Check for instance, REF INT i = LOC REF INT.  */
+	      a68_semantic_pitfall (NEXT_NEXT (p), MOID (&x), IDENTITY_DECLARATION, GENERATOR);
+	    break;
+	  }
+	default:
+	  mode_check_identity_declaration (SUB (p));
+	  mode_check_identity_declaration (NEXT (p));
+	  break;
+	}
+    }
+}
+
+/* Mode check variable declaration.  */
+
+static void
+mode_check_variable_declaration (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      switch (ATTRIBUTE (p))
+	{
+	case DECLARER:
+	  mode_check_declarer (SUB (p));
+	  mode_check_variable_declaration (NEXT (p));
+	  break;
+	case DEFINING_IDENTIFIER:
+	  if (a68_whether (p, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP))
+	    {
+	      SOID_T x, y;
+	      a68_make_soid (&x, STRONG, SUB_MOID (p), 0);
+	      mode_check_unit (NEXT_NEXT (p), &x, &y);
+	      if (!a68_is_coercible_in_context (&y, &x, FORCE_DEFLEXING))
+		a68_cannot_coerce (p, MOID (&y), MOID (&x), STRONG, FORCE_DEFLEXING, UNIT);
+	      else if (SUB_MOID (&x) != MOID (&y))
+		/* Check for instance, REF INT i = LOC REF INT.  */
+		a68_semantic_pitfall (NEXT_NEXT (p), MOID (&x), VARIABLE_DECLARATION, GENERATOR);
+	    }
+	  break;
+	default:
+	  mode_check_variable_declaration (SUB (p));
+	  mode_check_variable_declaration (NEXT (p));
+	  break;
+	}
+    }
+}
+
+/* Mode check routine text.  */
+
+static void
+mode_check_routine_text (NODE_T *p, SOID_T *y)
+{
+  SOID_T w;
+
+  if (IS (p, PARAMETER_PACK))
+    {
+      mode_check_declarer (SUB (p));
+      FORWARD (p);
+    }
+
+  mode_check_declarer (SUB (p));
+  a68_make_soid (&w, STRONG, MOID (p), 0);
+  mode_check_unit (NEXT_NEXT (p), &w, y);
+  if (!a68_is_coercible_in_context (y, &w, FORCE_DEFLEXING))
+    a68_cannot_coerce (NEXT_NEXT (p), MOID (y), MOID (&w), STRONG, FORCE_DEFLEXING, UNIT);
+}
+
+/* Mode check proc declaration.  */
+
+static void
+mode_check_proc_declaration (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, ROUTINE_TEXT))
+    {
+      SOID_T x, y;
+      a68_make_soid (&x, STRONG, NO_MOID, 0);
+      mode_check_routine_text (SUB (p), &y);
+    }
+  else
+    {
+      mode_check_proc_declaration (SUB (p));
+      mode_check_proc_declaration (NEXT (p));
+    }
+}
+
+/* Mode check brief op declaration.  */
+
+static void
+mode_check_brief_op_declaration (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, DEFINING_OPERATOR))
+    {
+      SOID_T y;
+
+      if (MOID (p) != MOID (NEXT_NEXT (p)))
+	{
+	  SOID_T y2, x;
+	  a68_make_soid (&y2, NO_SORT, MOID (NEXT_NEXT (p)), 0);
+	  a68_make_soid (&x, NO_SORT, MOID (p), 0);
+	  a68_cannot_coerce (NEXT_NEXT (p), MOID (&y2), MOID (&x), STRONG, SKIP_DEFLEXING, ROUTINE_TEXT);
+	}
+      mode_check_routine_text (SUB (NEXT_NEXT (p)), &y);
+    }
+  else
+    {
+      mode_check_brief_op_declaration (SUB (p));
+      mode_check_brief_op_declaration (NEXT (p));
+    }
+}
+
+/* Mode check op declaration.  */
+
+static void
+mode_check_op_declaration (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, DEFINING_OPERATOR))
+    {
+      SOID_T y, x;
+      a68_make_soid (&x, STRONG, MOID (p), 0);
+      mode_check_unit (NEXT_NEXT (p), &x, &y);
+      if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING))
+	a68_cannot_coerce (NEXT_NEXT (p), MOID (&y), MOID (&x), STRONG, SAFE_DEFLEXING, UNIT);
+    }
+  else
+    {
+      mode_check_op_declaration (SUB (p));
+      mode_check_op_declaration (NEXT (p));
+    }
+}
+
+/* Mode check declaration list.  */
+
+static void
+mode_check_declaration_list (NODE_T * p)
+{
+  if (p != NO_NODE)
+    {
+      switch (ATTRIBUTE (p))
+	{
+	case IDENTITY_DECLARATION:
+	  mode_check_identity_declaration (SUB (p));
+	  break;
+	case VARIABLE_DECLARATION:
+	  mode_check_variable_declaration (SUB (p));
+	  break;
+	case MODE_DECLARATION:
+	  mode_check_declarer (SUB (p));
+	  break;
+	case PROCEDURE_DECLARATION:
+	case PROCEDURE_VARIABLE_DECLARATION:
+	  mode_check_proc_declaration (SUB (p));
+	  break;
+	case BRIEF_OPERATOR_DECLARATION:
+	  mode_check_brief_op_declaration (SUB (p));
+	  break;
+	case OPERATOR_DECLARATION:
+	  mode_check_op_declaration (SUB (p));
+	  break;
+	default:
+	  mode_check_declaration_list (SUB (p));
+	  mode_check_declaration_list (NEXT (p));
+	  break;
+	}
+    }
+}
+
+/* Mode check serial clause.  */
+
+static void
+mode_check_serial (SOID_T **r, NODE_T *p, SOID_T *x, bool k)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, INITIALISER_SERIES))
+    {
+      mode_check_serial (r, SUB (p), x, false);
+      mode_check_serial (r, NEXT (p), x, k);
+    }
+  else if (IS (p, DECLARATION_LIST))
+    mode_check_declaration_list (SUB (p));
+  else if (a68_is_one_of (p, LABEL, SEMI_SYMBOL, EXIT_SYMBOL, STOP))
+    mode_check_serial (r, NEXT (p), x, k);
+  else if (a68_is_one_of (p, SERIAL_CLAUSE, ENQUIRY_CLAUSE, STOP))
+    {
+      if (NEXT (p) != NO_NODE)
+	{
+	  if (IS (NEXT (p), EXIT_SYMBOL) || IS (NEXT (p), END_SYMBOL) || IS (NEXT (p), CLOSE_SYMBOL))
+	    mode_check_serial (r, SUB (p), x, true);
+	  else
+	    mode_check_serial (r, SUB (p), x, false);
+	  mode_check_serial (r, NEXT (p), x, k);
+	}
+      else
+	mode_check_serial (r, SUB (p), x, true);
+    }
+  else if (IS (p, LABELED_UNIT))
+    mode_check_serial (r, SUB (p), x, k);
+  else if (IS (p, UNIT))
+    {
+      SOID_T y;
+
+      if (k)
+	mode_check_unit (p, x, &y);
+      else
+	{
+	  SOID_T w;
+	  a68_make_soid (&w, STRONG, M_VOID, 0);
+	  mode_check_unit (p, &w, &y);
+	}
+      if (NEXT (p) != NO_NODE)
+	mode_check_serial (r, NEXT (p), x, k);
+      else
+	{
+	  if (k)
+	    a68_add_to_soid_list (r, p, &y);
+	}
+    }
+}
+
+/* Mode check serial clause units.  */
+
+static void
+mode_check_serial_units (NODE_T *p, SOID_T *x, SOID_T *y,
+			 int att __attribute__((unused)))
+{
+  SOID_T *top_sl = NO_SOID;
+
+  mode_check_serial (&top_sl, SUB (p), x, true);
+  if (a68_is_balanced (p, top_sl, SORT (x)))
+    {
+      MOID_T *result = a68_pack_soids_in_moid (top_sl, SERIES_MODE);
+      a68_make_soid (y, SORT (x), result, SERIAL_CLAUSE);
+    }
+  else
+    a68_make_soid (y, SORT (x), (MOID (x) != NO_MOID ? MOID (x) : M_ERROR), 0);
+
+  a68_free_soid_list (top_sl);
+}
+
+/* Mode check unit list.  */
+
+static void
+mode_check_unit_list (SOID_T **r, NODE_T *p, SOID_T *x)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, UNIT_LIST))
+    {
+      mode_check_unit_list (r, SUB (p), x);
+      mode_check_unit_list (r, NEXT (p), x);
+    }
+  else if (IS (p, COMMA_SYMBOL))
+    mode_check_unit_list (r, NEXT (p), x);
+  else if (IS (p, UNIT))
+    {
+      SOID_T y;
+      mode_check_unit (p, x, &y);
+      a68_add_to_soid_list (r, p, &y);
+      mode_check_unit_list (r, NEXT (p), x);
+    }
+}
+
+/* Mode check struct display.  */
+
+static void
+mode_check_struct_display (SOID_T **r, NODE_T *p, PACK_T **fields)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, UNIT_LIST))
+    {
+      mode_check_struct_display (r, SUB (p), fields);
+      mode_check_struct_display (r, NEXT (p), fields);
+    }
+  else if (IS (p, COMMA_SYMBOL))
+    mode_check_struct_display (r, NEXT (p), fields);
+  else if (IS (p, UNIT))
+    {
+      SOID_T x, y;
+
+      if (*fields != NO_PACK)
+	{
+	  a68_make_soid (&x, STRONG, MOID (*fields), 0);
+	  FORWARD (*fields);
+	}
+      else
+	a68_make_soid (&x, STRONG, NO_MOID, 0);
+    mode_check_unit (p, &x, &y);
+    a68_add_to_soid_list (r, p, &y);
+    mode_check_struct_display (r, NEXT (p), fields);
+    }
+}
+
+/* Mode check get specified moids.  */
+
+static void
+mode_check_get_specified_moids (NODE_T *p, MOID_T *u)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (a68_is_one_of (p, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT, STOP))
+	mode_check_get_specified_moids (SUB (p), u);
+      else if (IS (p, SPECIFIER))
+       {
+	 MOID_T *m = MOID (NEXT_SUB (p));
+	 a68_add_mode_to_pack (&(PACK (u)), m, NO_TEXT, NODE (m));
+       }
+    }
+}
+
+/* Mode check specified unit list.  */
+
+void
+mode_check_specified_unit_list (SOID_T **r, NODE_T *p, SOID_T *x, MOID_T *u)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (a68_is_one_of (p, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT, STOP))
+	mode_check_specified_unit_list (r, SUB (p), x, u);
+      else if (IS (p, SPECIFIER))
+	{
+	  MOID_T *m = MOID (NEXT_SUB (p));
+	  if (u != NO_MOID && !a68_is_unitable (m, u, SAFE_DEFLEXING))
+	    a68_error (p, "M is neither component nor subset of M", m, u);
+
+	}
+      else if (IS (p, UNIT))
+	{
+	  SOID_T y;
+	  mode_check_unit (p, x, &y);
+	  a68_add_to_soid_list (r, p, &y);
+	}
+    }
+}
+
+/* Mode check united case parts.  */
+
+static void
+mode_check_united_case_parts (SOID_T **ry, NODE_T *p, SOID_T *x)
+{
+  SOID_T enq_expct, enq_yield;
+  MOID_T *u = NO_MOID, *v = NO_MOID, *w = NO_MOID;
+  /* Check the CASE part and deduce the united mode.  */
+  a68_make_soid (&enq_expct, MEEK, NO_MOID, 0);
+  mode_check_serial_units (NEXT_SUB (p), &enq_expct, &enq_yield, ENQUIRY_CLAUSE);
+  /* Deduce the united mode from the enquiry clause.
+     This requires balancing.  */
+  u = MOID (&enq_yield);
+  a68_absorb_series_pack (&u);
+  DIM (u) = a68_count_pack_members (PACK (u));
+  if (DIM (u) == 1)
+    u = MOID (PACK (u));
+  else
+    {
+      MOID_T *united, *balanced;
+      united = a68_make_united_mode (u);
+      balanced = a68_get_balanced_mode_or_no_mode (united,
+						   STRONG, A68_NO_DEPREF,
+						   SAFE_DEFLEXING);
+      if (balanced != NO_MOID)
+	u = balanced;
+    }
+  u = a68_depref_completely (u);
+  /* Also deduce the united mode from the specifiers.  */
+  v = a68_new_moid ();
+  ATTRIBUTE (v) = SERIES_MODE;
+  mode_check_get_specified_moids (NEXT_SUB (NEXT (p)), v);
+  v = a68_make_united_mode (v);
+  /* Determine a resulting union.  */
+  if (u == M_HIP)
+    w = v;
+  else
+    {
+      if (IS (u, UNION_SYMBOL))
+	{
+	  bool uv, vu, some;
+	  a68_investigate_firm_relations (PACK (u), PACK (v), &uv, &some);
+	  a68_investigate_firm_relations (PACK (v), PACK (u), &vu, &some);
+	  if (uv && vu)
+	    {
+	      /* Every component has a specifier.  */
+	      w = u;
+	    }
+	  else if (!uv && !vu)
+	    {
+	      /* Hmmmm ... let the coercer sort it out.  */
+	      w = u;
+	    }
+	  else
+	    {
+	      /* This is all the balancing we allow here for the moment. Firmly
+		 related subsets are not valid so we absorb them. If this
+		 doesn't solve it then we get a coercion-error later. */
+	      w = a68_absorb_related_subsets (u);
+	    }
+	}
+      else
+	{
+	  a68_error (NEXT_SUB (p), "M is not a united mode", u);
+	  return;
+	}
+    }
+  MOID (SUB (p)) = w;
+  FORWARD (p);
+  /* Check the IN part.  */
+  mode_check_specified_unit_list (ry, NEXT_SUB (p), x, w);
+  /* OUSE, OUT, ESAC.  */
+  if ((FORWARD (p)) != NO_NODE)
+    {
+      if (a68_is_one_of (p, OUT_PART, CHOICE, STOP))
+	mode_check_serial (ry, NEXT_SUB (p), x, true);
+      else if (a68_is_one_of (p, CONFORMITY_OUSE_PART, BRIEF_CONFORMITY_OUSE_PART, STOP))
+	mode_check_united_case_parts (ry, SUB (p), x);
+    }
+}
+
+/* Mode check united case.  */
+
+static void
+mode_check_united_case (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  SOID_T *top_sl = NO_SOID;
+
+  mode_check_united_case_parts (&top_sl, p, x);
+  if (!a68_is_balanced (p, top_sl, SORT (x)))
+    {
+      if (MOID (x) != NO_MOID)
+	a68_make_soid (y, SORT (x), MOID (x), CONFORMITY_CLAUSE);
+      else
+	a68_make_soid (y, SORT (x), M_ERROR, 0);
+    }
+  else
+    {
+      MOID_T *z = a68_pack_soids_in_moid (top_sl, SERIES_MODE);
+      a68_make_soid (y, SORT (x), z, CONFORMITY_CLAUSE);
+    }
+  a68_free_soid_list (top_sl);
+}
+
+/* Mode check unit list 2.  */
+
+static void
+mode_check_unit_list_2 (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  SOID_T *top_sl = NO_SOID;
+
+  if (MOID (x) != NO_MOID)
+    {
+      if (IS_FLEX (MOID (x)))
+	{
+	  SOID_T y2;
+	  a68_make_soid (&y2, SORT (x), SLICE (SUB_MOID (x)), 0);
+	  mode_check_unit_list (&top_sl, SUB (p), &y2);
+	}
+      else if (IS_ROW (MOID (x)))
+	{
+	  SOID_T y2;
+	  a68_make_soid (&y2, SORT (x), SLICE (MOID (x)), 0);
+	  mode_check_unit_list (&top_sl, SUB (p), &y2);
+	}
+      else if (IS (MOID (x), STRUCT_SYMBOL))
+	{
+	  PACK_T *y2 = PACK (MOID (x));
+	  mode_check_struct_display (&top_sl, SUB (p), &y2);
+	}
+      else
+	mode_check_unit_list (&top_sl, SUB (p), x);
+    }
+  else
+    mode_check_unit_list (&top_sl, SUB (p), x);
+
+  a68_make_soid (y, STRONG, a68_pack_soids_in_moid (top_sl, STOWED_MODE), 0);
+  a68_free_soid_list (top_sl);
+}
+
+/* Mode check closed.  */
+
+static void
+mode_check_closed (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, SERIAL_CLAUSE))
+    mode_check_serial_units (p, x, y, SERIAL_CLAUSE);
+  else if (a68_is_one_of (p, OPEN_SYMBOL, BEGIN_SYMBOL, STOP))
+    mode_check_closed (NEXT (p), x, y);
+  MOID (p) = MOID (y);
+}
+
+/* Mode check collateral.  */
+
+void
+mode_check_collateral (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  if (p == NO_NODE)
+    return;
+  else if (a68_whether (p, BEGIN_SYMBOL, END_SYMBOL, STOP)
+	   || a68_whether (p, OPEN_SYMBOL, CLOSE_SYMBOL, STOP))
+    {
+      if (SORT (x) == STRONG)
+	{
+	  if (MOID (x) == NO_MOID)
+	    a68_error (p, "vacuum cannot have row elements (use a Y generator)",
+		       "REF MODE");
+	  else
+	    a68_make_soid (y, STRONG, M_VACUUM, 0);
+	}
+      else
+	a68_make_soid (y, STRONG, M_UNDEFINED, 0);
+    }
+  else
+    {
+      if (IS (p, UNIT_LIST))
+	mode_check_unit_list_2 (p, x, y);
+      else if (a68_is_one_of (p, OPEN_SYMBOL, BEGIN_SYMBOL, STOP))
+	mode_check_collateral (NEXT (p), x, y);
+      MOID (p) = MOID (y);
+    }
+}
+
+/* Mode check conditional 2.  */
+
+static void
+mode_check_conditional_2 (SOID_T **ry, NODE_T *p, SOID_T *x)
+{
+  SOID_T enq_expct, enq_yield;
+
+  a68_make_soid (&enq_expct, MEEK, M_BOOL, 0);
+  mode_check_serial_units (NEXT_SUB (p), &enq_expct, &enq_yield, ENQUIRY_CLAUSE);
+  if (!a68_is_coercible_in_context (&enq_yield, &enq_expct, SAFE_DEFLEXING))
+    a68_cannot_coerce (p, MOID (&enq_yield), MOID (&enq_expct), MEEK, SAFE_DEFLEXING, ENQUIRY_CLAUSE);
+  FORWARD (p);
+  mode_check_serial (ry, NEXT_SUB (p), x, true);
+  if ((FORWARD (p)) != NO_NODE)
+    {
+      if (a68_is_one_of (p, ELSE_PART, CHOICE, STOP))
+	mode_check_serial (ry, NEXT_SUB (p), x, true);
+      else if (a68_is_one_of (p, ELIF_PART, BRIEF_ELIF_PART, STOP))
+	mode_check_conditional_2 (ry, SUB (p), x);
+    }
+}
+
+/* Mode check conditional.  */
+
+static void
+mode_check_conditional (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  SOID_T *top_sl = NO_SOID;
+  mode_check_conditional_2 (&top_sl, p, x);
+  if (!a68_is_balanced (p, top_sl, SORT (x)))
+    {
+      if (MOID (x) != NO_MOID)
+	a68_make_soid (y, SORT (x), MOID (x), CONDITIONAL_CLAUSE);
+      else
+	a68_make_soid (y, SORT (x), M_ERROR, 0);
+    }
+  else
+    {
+      MOID_T *z = a68_pack_soids_in_moid (top_sl, SERIES_MODE);
+      a68_make_soid (y, SORT (x), z, CONDITIONAL_CLAUSE);
+    }
+  a68_free_soid_list (top_sl);
+}
+
+/* Mode check int case 2.  */
+
+static void
+mode_check_int_case_2 (SOID_T **ry, NODE_T *p, SOID_T *x)
+{
+  SOID_T enq_expct, enq_yield;
+  a68_make_soid (&enq_expct, MEEK, M_INT, 0);
+  mode_check_serial_units (NEXT_SUB (p), &enq_expct, &enq_yield, ENQUIRY_CLAUSE);
+  if (!a68_is_coercible_in_context (&enq_yield, &enq_expct, SAFE_DEFLEXING))
+    a68_cannot_coerce (p, MOID (&enq_yield), MOID (&enq_expct), MEEK, SAFE_DEFLEXING, ENQUIRY_CLAUSE);
+  FORWARD (p);
+  mode_check_unit_list (ry, NEXT_SUB (p), x);
+  if ((FORWARD (p)) != NO_NODE)
+    {
+    if (a68_is_one_of (p, OUT_PART, CHOICE, STOP))
+      mode_check_serial (ry, NEXT_SUB (p), x, true);
+    else if (a68_is_one_of (p, CASE_OUSE_PART, BRIEF_OUSE_PART, STOP))
+      mode_check_int_case_2 (ry, SUB (p), x);
+    }
+}
+
+/* Mode check int case.  */
+
+static void
+mode_check_int_case (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  SOID_T *top_sl = NO_SOID;
+  mode_check_int_case_2 (&top_sl, p, x);
+  if (!a68_is_balanced (p, top_sl, SORT (x)))
+    {
+      if (MOID (x) != NO_MOID)
+	a68_make_soid (y, SORT (x), MOID (x), CASE_CLAUSE);
+      else
+	a68_make_soid (y, SORT (x), M_ERROR, 0);
+    }
+  else
+    {
+      MOID_T *z = a68_pack_soids_in_moid (top_sl, SERIES_MODE);
+      a68_make_soid (y, SORT (x), z, CASE_CLAUSE);
+    }
+  a68_free_soid_list (top_sl);
+}
+
+/* Mode check loop 2.  */
+
+static void
+mode_check_loop_2 (NODE_T *p, SOID_T *y)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, FOR_PART))
+    mode_check_loop_2 (NEXT (p), y);
+  else if (a68_is_one_of (p, FROM_PART, BY_PART, TO_PART, STOP))
+    {
+      SOID_T ix, iy;
+      a68_make_soid (&ix, STRONG, M_INT, 0);
+      mode_check_unit (NEXT_SUB (p), &ix, &iy);
+      if (!a68_is_coercible_in_context (&iy, &ix, SAFE_DEFLEXING))
+	a68_cannot_coerce (NEXT_SUB (p), MOID (&iy), M_INT, MEEK, SAFE_DEFLEXING, ENQUIRY_CLAUSE);
+      mode_check_loop_2 (NEXT (p), y);
+    }
+  else if (IS (p, WHILE_PART))
+    {
+      SOID_T enq_expct, enq_yield;
+      a68_make_soid (&enq_expct, MEEK, M_BOOL, 0);
+      mode_check_serial_units (NEXT_SUB (p), &enq_expct, &enq_yield, ENQUIRY_CLAUSE);
+      if (!a68_is_coercible_in_context (&enq_yield, &enq_expct, SAFE_DEFLEXING))
+	a68_cannot_coerce (p, MOID (&enq_yield), MOID (&enq_expct), MEEK, SAFE_DEFLEXING, ENQUIRY_CLAUSE);
+      mode_check_loop_2 (NEXT (p), y);
+    }
+  else if (a68_is_one_of (p, DO_PART, ALT_DO_PART, STOP))
+    {
+      SOID_T *z = NO_SOID;
+      NODE_T *do_p = NEXT_SUB (p);
+      SOID_T ix;
+      a68_make_soid (&ix, STRONG, M_VOID, 0);
+      if (IS (do_p, SERIAL_CLAUSE))
+	mode_check_serial (&z, do_p, &ix, true);
+      a68_free_soid_list (z);
+    }
+}
+
+/* Mode check loop.  */
+
+static void
+mode_check_loop (NODE_T *p, SOID_T *y)
+{
+  SOID_T *z = NO_SOID;
+  mode_check_loop_2 (p, z);
+  a68_make_soid (y, STRONG, M_VOID, 0);
+}
+
+/* Mode check enclosed.  */
+
+static void
+mode_check_enclosed (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, ENCLOSED_CLAUSE))
+    mode_check_enclosed (SUB (p), x, y);
+  else if (IS (p, CLOSED_CLAUSE))
+    mode_check_closed (SUB (p), x, y);
+  else if (IS (p, PARALLEL_CLAUSE))
+    {
+      mode_check_collateral (SUB (NEXT_SUB (p)), x, y);
+      a68_make_soid (y, STRONG, M_VOID, 0);
+      MOID (NEXT_SUB (p)) = M_VOID;
+    }
+  else if (IS (p, COLLATERAL_CLAUSE))
+    mode_check_collateral (SUB (p), x, y);
+  else if (IS (p, CONDITIONAL_CLAUSE))
+    mode_check_conditional (SUB (p), x, y);
+  else if (IS (p, CASE_CLAUSE))
+    mode_check_int_case (SUB (p), x, y);
+  else if (IS (p, CONFORMITY_CLAUSE))
+    mode_check_united_case (SUB (p), x, y);
+  else if (IS (p, LOOP_CLAUSE))
+    mode_check_loop (SUB (p), y);
+
+  MOID (p) = MOID (y);
+}
+
+/* Search table for operator.  */
+
+static TAG_T *search_table_for_operator (TAG_T *t, const char *n, MOID_T *x, MOID_T *y)
+{
+  if (a68_is_mode_isnt_well (x))
+    return A68_PARSER (error_tag);
+  else if (y != NO_MOID && a68_is_mode_isnt_well (y))
+    return A68_PARSER (error_tag);
+
+  for (; t != NO_TAG; FORWARD (t))
+    {
+      if (NSYMBOL (NODE (t)) == n)
+	{
+	  PACK_T *p = PACK (MOID (t));
+	  if (a68_is_coercible (x, MOID (p), FIRM, ALIAS_DEFLEXING))
+	    {
+	      FORWARD (p);
+	      if (p == NO_PACK && y == NO_MOID)
+		/* Matched in case of a monadic.  */
+		return t;
+	      else if (p != NO_PACK && y != NO_MOID
+		       && a68_is_coercible (y, MOID (p), FIRM, ALIAS_DEFLEXING))
+		/* Matched in case of a dyadic.  */
+		return t;
+	    }
+	}
+    }
+  return NO_TAG;
+}
+
+/* Search chain of symbol tables and return matching operator "x n y" or
+   "n x".  */
+
+static TAG_T *
+search_table_chain_for_operator (TABLE_T *s, const char *n, MOID_T *x, MOID_T *y)
+{
+  if (a68_is_mode_isnt_well (x))
+    return A68_PARSER (error_tag);
+  else if (y != NO_MOID && a68_is_mode_isnt_well (y))
+    return A68_PARSER (error_tag);
+
+  while (s != NO_TABLE)
+    {
+      TAG_T *z = search_table_for_operator (OPERATORS (s), n, x, y);
+      if (z != NO_TAG)
+	return z;
+      BACKWARD (s);
+    }
+  return NO_TAG;
+}
+
+/* Return a matching operator "x n y".  */
+
+static TAG_T *
+find_operator (TABLE_T *s, const char *n, MOID_T *x, MOID_T *y)
+{
+  /* Coercions to operand modes are FIRM.  */
+  MOID_T *u, *v; TAG_T *z;
+  /* (A) Catch exceptions first.  */
+  if (x == NO_MOID && y == NO_MOID)
+    return NO_TAG;
+  else if (a68_is_mode_isnt_well (x))
+    return A68_PARSER (error_tag);
+  else if (y != NO_MOID && a68_is_mode_isnt_well (y))
+    return A68_PARSER (error_tag);
+
+  /* (B) MONADs.  */
+  if (x != NO_MOID && y == NO_MOID)
+    {
+      z = search_table_chain_for_operator (s, n, x, NO_MOID);
+      if (z != NO_TAG)
+      return z;
+      else
+	{
+	  /* (B.2) A little trick to allow - (0, 1) or ABS (1, long pi).  */
+	  if (a68_is_coercible (x, M_COMPLEX, STRONG, SAFE_DEFLEXING))
+	    {
+	      z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_COMPLEX, NO_MOID);
+	      if (z != NO_TAG)
+		return z;
+	    }
+	  if (a68_is_coercible (x, M_LONG_COMPLEX, STRONG, SAFE_DEFLEXING))
+	    {
+	      z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_LONG_COMPLEX, NO_MOID);
+	      if (z != NO_TAG)
+		return z;
+	    }
+	  if (a68_is_coercible (x, M_LONG_LONG_COMPLEX, STRONG, SAFE_DEFLEXING))
+	    z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_LONG_LONG_COMPLEX, NO_MOID);
+	}
+      return NO_TAG;
+    }
+  /* (C) DYADs.  */
+  z = search_table_chain_for_operator (s, n, x, y);
+  if (z != NO_TAG)
+    return z;
+  /* (C.2) Vector and matrix "strong coercions" in standard environ.  */
+  u = DEFLEX (a68_depref_completely (x));
+  v = DEFLEX (a68_depref_completely (y));
+  if ((u == M_ROW_REAL || u == M_ROW_ROW_REAL)
+      || (v == M_ROW_REAL || v == M_ROW_ROW_REAL)
+      || (u == M_ROW_COMPLEX || u == M_ROW_ROW_COMPLEX)
+      || (v == M_ROW_COMPLEX || v == M_ROW_ROW_COMPLEX))
+    {
+      if (u == M_INT)
+	{
+	  z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_REAL, y);
+	  if (z != NO_TAG)
+	    return z;
+	  z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_COMPLEX, y);
+	  if (z != NO_TAG)
+	    return z;
+	}
+      else if (v == M_INT)
+	{
+	  z = search_table_for_operator (OPERATORS (A68_STANDENV), n, x, M_REAL);
+	  if (z != NO_TAG)
+	    return z;
+	  z = search_table_for_operator (OPERATORS (A68_STANDENV), n, x, M_COMPLEX);
+	  if (z != NO_TAG)
+	    return z;
+	}
+      else if (u == M_REAL)
+	{
+	  z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_COMPLEX, y);
+	  if (z != NO_TAG)
+	    return z;
+	}
+      else if (v == M_REAL)
+	{
+	  z = search_table_for_operator (OPERATORS (A68_STANDENV), n, x, M_COMPLEX);
+	  if (z != NO_TAG)
+	    return z;
+	}
+    }
+  /* (C.3) Look in standenv for an appropriate cross-term.  */
+  u = a68_make_series_from_moids (x, y);
+  u = a68_make_united_mode (u);
+  v = a68_get_balanced_mode (u, STRONG, A68_NO_DEPREF, SAFE_DEFLEXING);
+  z = search_table_for_operator (OPERATORS (A68_STANDENV), n, v, v);
+  if (z != NO_TAG)
+    return z;
+  if (a68_is_coercible_series (u, M_REAL, STRONG, SAFE_DEFLEXING))
+    {
+      z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_REAL, M_REAL);
+      if (z != NO_TAG)
+	return z;
+    }
+  if (a68_is_coercible_series (u, M_LONG_REAL, STRONG, SAFE_DEFLEXING))
+    {
+      z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_LONG_REAL, M_LONG_REAL);
+      if (z != NO_TAG)
+	return z;
+    }
+  if (a68_is_coercible_series (u, M_LONG_LONG_REAL, STRONG, SAFE_DEFLEXING))
+    {
+      z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_LONG_LONG_REAL, M_LONG_LONG_REAL);
+      if (z != NO_TAG)
+	return z;
+  }
+  if (a68_is_coercible_series (u, M_COMPLEX, STRONG, SAFE_DEFLEXING))
+    {
+      z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_COMPLEX, M_COMPLEX);
+      if (z != NO_TAG)
+	return z;
+    }
+  if (a68_is_coercible_series (u, M_LONG_COMPLEX, STRONG, SAFE_DEFLEXING))
+    {
+      z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_LONG_COMPLEX, M_LONG_COMPLEX);
+      if (z != NO_TAG)
+	return z;
+    }
+  if (a68_is_coercible_series (u, M_LONG_LONG_COMPLEX, STRONG, SAFE_DEFLEXING))
+    {
+      z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX);
+      if (z != NO_TAG)
+	return z;
+    }
+  /* (C.4) Now allow for depreffing for REF REAL +:= INT and alike.  */
+  v = a68_get_balanced_mode (u, STRONG, A68_DEPREF, SAFE_DEFLEXING);
+  z = search_table_for_operator (OPERATORS (A68_STANDENV), n, v, v);
+  if (z != NO_TAG)
+    return z;
+  return NO_TAG;
+}
+
+/* Mode check monadic operator.  */
+
+static void
+mode_check_monadic_operator (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  if (p != NO_NODE)
+    {
+      TAG_T *t;
+      MOID_T *u = a68_determine_unique_mode (y, SAFE_DEFLEXING);
+      if (a68_is_mode_isnt_well (u))
+	a68_make_soid (y, SORT (x), M_ERROR, 0);
+     else if (u == M_HIP)
+       {
+	 a68_error (NEXT (p), "M construct is an invalid operand", u);
+	 a68_make_soid (y, SORT (x), M_ERROR, 0);
+       }
+     else
+       {
+	 if (strchr (NOMADS, *(NSYMBOL (p))) != NO_TEXT)
+	   {
+	     t = NO_TAG;
+	     a68_error (p, "monadic S cannot start with a character from Z", NOMADS);
+	     a68_make_soid (y, SORT (x), M_ERROR, 0);
+	   }
+	 else
+	   {
+	     t = find_operator (TABLE (p), NSYMBOL (p), u, NO_MOID);
+	     if (t == NO_TAG)
+	       {
+		 a68_error (p, "monadic operator S O has not been declared", u);
+		 a68_make_soid (y, SORT (x), M_ERROR, 0);
+	       }
+	   }
+	 if (t != NO_TAG)
+	   MOID (p) = MOID (t);
+	 TAX (p) = t;
+	 if (t != NO_TAG && t != A68_PARSER (error_tag))
+	   {
+	     MOID (p) = MOID (t);
+	     a68_make_soid (y, SORT (x), SUB_MOID (t), 0);
+	   }
+	 else
+	   {
+	     MOID (p) = M_ERROR;
+	     a68_make_soid (y, SORT (x), M_ERROR, 0);
+	   }
+       }
+    }
+}
+
+/* Mode check monadic formula.  */
+
+static void
+mode_check_monadic_formula (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  SOID_T e;
+  a68_make_soid (&e, FIRM, NO_MOID, 0);
+  mode_check_formula (NEXT (p), &e, y);
+  mode_check_monadic_operator (p, &e, y);
+  a68_make_soid (y, SORT (x), MOID (y), 0);
+}
+
+/* Mode check formula.  */
+
+static void
+mode_check_formula (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  SOID_T ls;
+  if (IS (p, MONADIC_FORMULA))
+    mode_check_monadic_formula (SUB (p), x, &ls);
+  else if (IS (p, FORMULA))
+    mode_check_formula (SUB (p), x, &ls);
+  else if (IS (p, SECONDARY))
+    {
+      SOID_T e;
+      a68_make_soid (&e, FIRM, NO_MOID, 0);
+      mode_check_unit (SUB (p), &e, &ls);
+    }
+  MOID_T *u = a68_determine_unique_mode (&ls, SAFE_DEFLEXING);
+  MOID (p) = u;
+  SOID_T rs;
+  if (NEXT (p) == NO_NODE)
+    a68_make_soid (y, SORT (x), u, 0);
+  else
+    {
+      NODE_T *q = NEXT_NEXT (p);
+      if (IS (q, MONADIC_FORMULA))
+	mode_check_monadic_formula (SUB (NEXT_NEXT (p)), x, &rs);
+      else if (IS (q, FORMULA))
+	mode_check_formula (SUB (NEXT_NEXT (p)), x, &rs);
+      else if (IS (q, SECONDARY))
+	{
+	  SOID_T e;
+	  a68_make_soid (&e, FIRM, NO_MOID, 0);
+	  mode_check_unit (SUB (q), &e, &rs);
+	}
+      MOID_T *v = a68_determine_unique_mode (&rs, SAFE_DEFLEXING);
+      MOID (q) = v;
+      if (a68_is_mode_isnt_well (u) || a68_is_mode_isnt_well (v))
+	a68_make_soid (y, SORT (x), M_ERROR, 0);
+      else if (u == M_HIP)
+	{
+	  a68_error (p, "M construct is an invalid operand", u);
+	  a68_make_soid (y, SORT (x), M_ERROR, 0);
+	}
+      else if (v == M_HIP)
+	{
+	  a68_error (q, "M construct is an invalid operand", u);
+	  a68_make_soid (y, SORT (x), M_ERROR, 0);
+	}
+      else
+	{
+	  TAG_T *op = find_operator (TABLE (NEXT (p)), NSYMBOL (NEXT (p)), u, v);
+	  if (op == NO_TAG)
+	    {
+	      a68_error (NEXT (p), "dyadic operator O S O has not been declared", u, v);
+	      a68_make_soid (y, SORT (x), M_ERROR, 0);
+	    }
+	  if (op != NO_TAG)
+	    MOID (NEXT (p)) = MOID (op);
+	  TAX (NEXT (p)) = op;
+	  if (op != NO_TAG && op != A68_PARSER (error_tag))
+	    a68_make_soid (y, SORT (x), SUB_MOID (op), 0);
+	  else
+	    a68_make_soid (y, SORT (x), M_ERROR, 0);
+	}
+    }
+}
+
+/* Mode check assignation.  */
+
+static void
+mode_check_assignation (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  /* Get destination mode.  */
+  SOID_T name, tmp, value;
+  a68_make_soid (&name, SOFT, NO_MOID, 0);
+  mode_check_unit (SUB (p), &name, &tmp);
+  /* SOFT coercion.  */
+  MOID_T *ori = a68_determine_unique_mode (&tmp, SAFE_DEFLEXING);
+  MOID_T *name_moid = a68_deproc_completely (ori);
+  if (ATTRIBUTE (name_moid) != REF_SYMBOL)
+    {
+      if (A68_IF_MODE_IS_WELL (name_moid))
+	a68_error (p, "M A does not yield a name", ori, ATTRIBUTE (SUB (p)));
+      a68_make_soid (y, SORT (x), M_ERROR, 0);
+      return;
+    }
+  MOID (p) = name_moid;
+  /* Get source mode.  */
+  a68_make_soid (&name, STRONG, SUB (name_moid), 0);
+  mode_check_unit (NEXT_NEXT (p), &name, &value);
+  if (!a68_is_coercible_in_context (&value, &name, FORCE_DEFLEXING))
+    {
+      a68_cannot_coerce (p, MOID (&value), MOID (&name), STRONG, FORCE_DEFLEXING, UNIT);
+      a68_make_soid (y, SORT (x), M_ERROR, 0);
+    }
+  else
+    a68_make_soid (y, SORT (x), name_moid, 0);
+}
+
+/* Mode check identity relation.  */
+
+static void
+mode_check_identity_relation (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  NODE_T *ln = p, *rn = NEXT_NEXT (p);
+  SOID_T e, l, r;
+  a68_make_soid (&e, SOFT, NO_MOID, 0);
+  mode_check_unit (SUB (ln), &e, &l);
+  mode_check_unit (SUB (rn), &e, &r);
+  /* SOFT coercion.  */
+  MOID_T *oril = a68_determine_unique_mode (&l, SAFE_DEFLEXING);
+  MOID_T *orir = a68_determine_unique_mode (&r, SAFE_DEFLEXING);
+  MOID_T *lhs = a68_deproc_completely (oril);
+  MOID_T *rhs = a68_deproc_completely (orir);
+  if (A68_IF_MODE_IS_WELL (lhs) && lhs != M_HIP && ATTRIBUTE (lhs) != REF_SYMBOL)
+    {
+      a68_error (ln, "M A does not yield a name", oril, ATTRIBUTE (SUB (ln)));
+      lhs = M_ERROR;
+    }
+  if (A68_IF_MODE_IS_WELL (rhs) && rhs != M_HIP && ATTRIBUTE (rhs) != REF_SYMBOL)
+    {
+      a68_error (rn, "M A does not yield a name", orir, ATTRIBUTE (SUB (rn)));
+      rhs = M_ERROR;
+    }
+  if (lhs == M_HIP && rhs == M_HIP)
+    a68_error (p, "construct has no unique mode");
+
+  if (a68_is_coercible (lhs, rhs, STRONG, SAFE_DEFLEXING))
+    lhs = rhs;
+  else if (a68_is_coercible (rhs, lhs, STRONG, SAFE_DEFLEXING))
+    rhs = lhs;
+  else
+    {
+      a68_cannot_coerce (NEXT (p), rhs, lhs, SOFT, SKIP_DEFLEXING, TERTIARY);
+      lhs = rhs = M_ERROR;
+    }
+  MOID (ln) = lhs;
+  MOID (rn) = rhs;
+  a68_make_soid (y, SORT (x), M_BOOL, 0);
+}
+
+/* Mode check bool functions ANDF and ORF.  */
+
+static void
+mode_check_bool_function (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  SOID_T e, l, r;
+  NODE_T *ln = p, *rn = NEXT_NEXT (p);
+  a68_make_soid (&e, STRONG, M_BOOL, 0);
+  mode_check_unit (SUB (ln), &e, &l);
+  if (!a68_is_coercible_in_context (&l, &e, SAFE_DEFLEXING))
+    a68_cannot_coerce (ln, MOID (&l), MOID (&e), MEEK, SAFE_DEFLEXING, TERTIARY);
+  mode_check_unit (SUB (rn), &e, &r);
+  if (!a68_is_coercible_in_context (&r, &e, SAFE_DEFLEXING))
+    a68_cannot_coerce (rn, MOID (&r), MOID (&e), MEEK, SAFE_DEFLEXING, TERTIARY);
+  MOID (ln) = M_BOOL;
+  MOID (rn) = M_BOOL;
+  a68_make_soid (y, SORT (x), M_BOOL, 0);
+}
+
+/* Mode check cast.  */
+
+static void
+mode_check_cast (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  SOID_T w;
+  mode_check_declarer (p);
+  a68_make_soid (&w, STRONG, MOID (p), 0);
+  CAST (&w) = true;
+  mode_check_enclosed (SUB_NEXT (p), &w, y);
+  if (!a68_is_coercible_in_context (y, &w, SAFE_DEFLEXING))
+    a68_cannot_coerce (NEXT (p), MOID (y), MOID (&w), STRONG, SAFE_DEFLEXING, ENCLOSED_CLAUSE);
+  a68_make_soid (y, SORT (x), MOID (p), 0);
+}
+
+/* Mode check assertion.  */
+
+static void
+mode_check_assertion (NODE_T *p)
+{
+  SOID_T w, y;
+  a68_make_soid (&w, STRONG, M_BOOL, 0);
+  mode_check_enclosed (SUB_NEXT (p), &w, &y);
+  SORT (&y) = SORT (&w);
+  if (!a68_is_coercible_in_context (&y, &w, NO_DEFLEXING))
+    a68_cannot_coerce (NEXT (p), MOID (&y), MOID (&w), MEEK, NO_DEFLEXING, ENCLOSED_CLAUSE);
+}
+
+/* Mode check argument list.  */
+
+static void
+mode_check_argument_list (SOID_T **r, NODE_T *p, PACK_T **x, PACK_T **v, PACK_T **w)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, GENERIC_ARGUMENT_LIST))
+	ATTRIBUTE (p) = ARGUMENT_LIST;
+
+      if (IS (p, ARGUMENT_LIST))
+	mode_check_argument_list (r, SUB (p), x, v, w);
+      else if (IS (p, UNIT))
+	{
+	  SOID_T y, z;
+	  if (*x != NO_PACK)
+	    {
+	      a68_make_soid (&z, STRONG, MOID (*x), 0);
+	      a68_add_mode_to_pack_end (v, MOID (*x), NO_TEXT, p);
+	      FORWARD (*x);
+	    }
+	  else
+	    a68_make_soid (&z, STRONG, NO_MOID, 0);
+	  mode_check_unit (p, &z, &y);
+	  a68_add_to_soid_list (r, p, &y);
+	}
+      else if (IS (p, TRIMMER))
+	{
+	  SOID_T z;
+	  if (SUB (p) != NO_NODE)
+	    {
+	      a68_error (p, "syntax error detected in A", ARGUMENT);
+	      a68_make_soid (&z, STRONG, M_ERROR, 0);
+	      a68_add_mode_to_pack_end (v, M_VOID, NO_TEXT, p);
+	      a68_add_mode_to_pack_end (w, MOID (*x), NO_TEXT, p);
+	      FORWARD (*x);
+	    }
+	  else if (*x != NO_PACK)
+	    {
+	      a68_make_soid (&z, STRONG, MOID (*x), 0);
+	      a68_add_mode_to_pack_end (v, M_VOID, NO_TEXT, p);
+	      a68_add_mode_to_pack_end (w, MOID (*x), NO_TEXT, p);
+	      FORWARD (*x);
+	    }
+	  else
+	    a68_make_soid (&z, STRONG, NO_MOID, 0);
+	  a68_add_to_soid_list (r, p, &z);
+	}
+      else if (IS (p, SUB_SYMBOL) && !OPTION_BRACKETS (&A68_JOB))
+	a68_error (p, "syntax error detected in A", CALL);
+    }
+}
+
+/* Mode check argument list 2.  */
+
+static void
+mode_check_argument_list_2 (NODE_T *p, PACK_T *x, SOID_T *y, PACK_T **v, PACK_T **w)
+{
+  SOID_T *top_sl = NO_SOID;
+  mode_check_argument_list (&top_sl, SUB (p), &x, v, w);
+  a68_make_soid (y, STRONG, a68_pack_soids_in_moid (top_sl, STOWED_MODE), 0);
+  a68_free_soid_list (top_sl);
+}
+
+/* Mode check meek int.  */
+
+static void
+mode_check_meek_int (NODE_T *p)
+{
+  SOID_T x, y;
+  a68_make_soid (&x, MEEK, M_INT, 0);
+  mode_check_unit (p, &x, &y);
+  if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING))
+    a68_cannot_coerce (p, MOID (&y), MOID (&x), MEEK, SAFE_DEFLEXING, 0);
+}
+
+/* Mode check trimmer.  */
+
+static void
+mode_check_trimmer (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, TRIMMER))
+    mode_check_trimmer (SUB (p));
+  else if (IS (p, UNIT))
+    {
+      mode_check_meek_int (p);
+      mode_check_trimmer (NEXT (p));
+    }
+  else
+    mode_check_trimmer (NEXT (p));
+}
+
+/* Mode check indexer.  */
+
+static void
+mode_check_indexer (NODE_T *p, int *subs, int *trims)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, TRIMMER))
+   {
+     (*trims)++;
+     mode_check_trimmer (SUB (p));
+   }
+  else if (IS (p, UNIT))
+    {
+      (*subs)++;
+      mode_check_meek_int (p);
+    }
+  else
+    {
+      mode_check_indexer (SUB (p), subs, trims);
+      mode_check_indexer (NEXT (p), subs, trims);
+    }
+}
+
+/* Mode check call.  */
+
+static void
+mode_check_call (NODE_T *p, MOID_T *n, SOID_T *x, SOID_T *y)
+{
+  MOID (p) = n;
+  /* "partial_locale" is the mode of the locale.  */
+  PARTIAL_LOCALE (GINFO (p)) = a68_new_moid ();
+  ATTRIBUTE (PARTIAL_LOCALE (GINFO (p))) = PROC_SYMBOL;
+  PACK (PARTIAL_LOCALE (GINFO (p))) = NO_PACK;
+  SUB (PARTIAL_LOCALE (GINFO (p))) = SUB (n);
+  /* "partial_proc" is the mode of the resulting proc.  */
+  PARTIAL_PROC (GINFO (p)) = a68_new_moid ();
+  ATTRIBUTE (PARTIAL_PROC (GINFO (p))) = PROC_SYMBOL;
+  PACK (PARTIAL_PROC (GINFO (p))) = NO_PACK;
+  SUB (PARTIAL_PROC (GINFO (p))) = SUB (n);
+  /* Check arguments and construct modes.  */
+  SOID_T d;
+  mode_check_argument_list_2 (NEXT (p), PACK (n), &d, &PACK (PARTIAL_LOCALE (GINFO (p))),
+			      &PACK (PARTIAL_PROC (GINFO (p))));
+  DIM (PARTIAL_PROC (GINFO (p))) = a68_count_pack_members (PACK (PARTIAL_PROC (GINFO (p))));
+  DIM (PARTIAL_LOCALE (GINFO (p))) = a68_count_pack_members (PACK (PARTIAL_LOCALE (GINFO (p))));
+  PARTIAL_PROC (GINFO (p)) = a68_register_extra_mode (&TOP_MOID (&A68_JOB), PARTIAL_PROC (GINFO (p)));
+  PARTIAL_LOCALE (GINFO (p)) = a68_register_extra_mode (&TOP_MOID (&A68_JOB), PARTIAL_LOCALE (GINFO (p)));
+  if (DIM (MOID (&d)) != DIM (n))
+    {
+      a68_error (p, "incorrect number of arguments for M", n);
+      a68_make_soid (y, SORT (x), SUB (n), 0);
+      /*  a68_make_soid (y, SORT (x), M_ERROR, 0);.  */
+    }
+  else
+    {
+      if (!a68_is_coercible (MOID (&d), n, STRONG, ALIAS_DEFLEXING))
+	a68_cannot_coerce (p, MOID (&d), n, STRONG, ALIAS_DEFLEXING, ARGUMENT);
+      if (DIM (PARTIAL_PROC (GINFO (p))) == 0)
+	a68_make_soid (y, SORT (x), SUB (n), 0);
+      else
+	{
+	  a68_warning (NEXT (p), OPT_Wextensions, "@ is an extension");
+	  a68_make_soid (y, SORT (x), PARTIAL_PROC (GINFO (p)), 0);
+	}
+    }
+}
+
+/* Mode check slice.  */
+
+static void
+mode_check_slice (NODE_T *p, MOID_T *ori, SOID_T *x, SOID_T *y)
+{
+  MOID_T *m = a68_depref_completely (ori), *n = ori;
+  /* WEAK coercion.  */
+  while ((IS_REF (n) && !a68_is_ref_row (n)) || (IS (n, PROC_SYMBOL) && PACK (n) == NO_PACK))
+    n = a68_depref_once (n);
+
+  if (n == NO_MOID || !(SLICE (DEFLEX (n)) != NO_MOID || a68_is_ref_row (n)))
+    {
+      if (A68_IF_MODE_IS_WELL (n))
+	a68_error (p, "M A does not yield a row or procedure",
+		   n, ATTRIBUTE (SUB (p)));
+      a68_make_soid (y, SORT (x), M_ERROR, 0);
+    }
+
+  MOID (p) = n;
+  int dim = 0, subs = 0, trims = 0;
+  mode_check_indexer (SUB_NEXT (p), &subs, &trims);
+  bool is_ref;
+  if ((is_ref = a68_is_ref_row (n)) != 0)
+    dim = DIM (DEFLEX (SUB (n)));
+  else
+    dim = DIM (DEFLEX (n));
+
+  if ((subs + trims) != dim)
+    {
+      a68_error (p, "incorrect number of indexers for M", n);
+      a68_make_soid (y, SORT (x), M_ERROR, 0);
+    }
+  else
+    {
+      if (subs > 0 && trims == 0)
+	{
+	  ANNOTATION (NEXT (p)) = SLICE;
+	  m = n;
+	}
+      else
+	{
+	  ANNOTATION (NEXT (p)) = TRIMMER;
+	  m = n;
+	}
+      while (subs > 0)
+	{
+	  if (is_ref)
+	    m = NAME (m);
+	  else
+	    {
+	      if (IS_FLEX (m))
+		m = SUB (m);
+	      m = SLICE (m);
+	    }
+	  gcc_assert (m != NO_MOID);
+	  subs--;
+	}
+      /* A trim cannot be but deflexed.  */
+      if (ANNOTATION (NEXT (p)) == TRIMMER && TRIM (m) != NO_MOID)
+	{
+	  gcc_assert (TRIM (m) != NO_MOID);
+	  a68_make_soid (y, SORT (x), TRIM (m), 0);
+	}
+      else
+	a68_make_soid (y, SORT (x), m, 0);
+    }
+}
+
+/* Mode check specification.  */
+
+static enum a68_attribute
+mode_check_specification (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  SOID_T w, d;
+  a68_make_soid (&w, WEAK, NO_MOID, 0);
+  mode_check_unit (SUB (p), &w, &d);
+  MOID_T *ori = a68_determine_unique_mode (&d, SAFE_DEFLEXING);
+  MOID_T *m = a68_depref_completely (ori);
+  if (IS (m, PROC_SYMBOL))
+    {
+      /* Assume CALL.  */
+      mode_check_call (p, m, x, y);
+      return CALL;
+    }
+  else if (IS_ROW (m) || IS_FLEX (m))
+    {
+      /* Assume SLICE.  */
+      mode_check_slice (p, ori, x, y);
+      return SLICE;
+    }
+  else
+    {
+      if (m != M_ERROR)
+	a68_error (p, "M construct must yield a routine or a row value", m);
+      a68_make_soid (y, SORT (x), M_ERROR, 0);
+      return PRIMARY;
+    }
+}
+
+/* Mode check selection.  */
+
+static void
+mode_check_selection (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  bool deflex = false;
+  NODE_T *secondary = SUB_NEXT (p);
+  SOID_T w, d;
+  a68_make_soid (&w, WEAK, NO_MOID, 0);
+  mode_check_unit (secondary, &w, &d);
+  MOID_T *n, *ori;
+  n = ori = a68_determine_unique_mode (&d, SAFE_DEFLEXING);
+  PACK_T *t = NO_PACK, *t_2 = NO_PACK;
+  bool coerce = true;
+  while (coerce)
+    {
+      if (IS (n, STRUCT_SYMBOL))
+	{
+	  coerce = false;
+	  t = PACK (n);
+	}
+      else if (IS_REF (n) && (IS_ROW (SUB (n)) || IS_FLEX (SUB (n))) && MULTIPLE (n) != NO_MOID)
+	{
+	  coerce = false;
+	  deflex = true;
+	  t = PACK (MULTIPLE (n));
+	}
+      else if ((IS_ROW (n) || IS_FLEX (n)) && MULTIPLE (n) != NO_MOID)
+	{
+	  coerce = false;
+	  deflex = true;
+	  t = PACK (MULTIPLE (n));
+	}
+      else if (IS_REF (n) && a68_is_name_struct (n))
+	{
+	  coerce = false;
+	  t = PACK (NAME (n));
+	}
+      else if (a68_is_deprefable (n))
+	{
+	  coerce = true;
+	  n = SUB (n);
+	  t = NO_PACK;
+	}
+      else
+	{
+	  coerce = false;
+	  t = NO_PACK;
+	}
+    }
+  if (t == NO_PACK)
+    {
+      if (A68_IF_MODE_IS_WELL (MOID (&d)))
+	a68_error (secondary, "M A does not yield a structured value", ori, ATTRIBUTE (secondary));
+      a68_make_soid (y, SORT (x), M_ERROR, 0);
+      return;
+    }
+
+  MOID (NEXT (p)) = n;
+  const char *fs = NSYMBOL (SUB (p));
+  MOID_T *str = n;
+  while (IS_REF (str))
+    str = SUB (str);
+  if (IS_FLEX (str))
+    str = SUB (str);
+  if (IS_ROW (str))
+    str = SUB (str);
+  t_2 = PACK (str);
+  while (t != NO_PACK && t_2 != NO_PACK)
+    {
+      if (TEXT (t) == fs)
+	{
+	  MOID_T *ret = MOID (t);
+	  if (deflex && TRIM (ret) != NO_MOID)
+	    ret = TRIM (ret);
+	  a68_make_soid (y, SORT (x), ret, 0);
+	  MOID (p) = ret;
+	  NODE_PACK (SUB (p)) = t_2;
+	  return;
+	}
+      FORWARD (t);
+      FORWARD (t_2);
+    }
+  a68_make_soid (&d, NO_SORT, n, 0);
+  a68_error (p, "M has no field Z", str, fs);
+  a68_make_soid (y, SORT (x), M_ERROR, 0);
+}
+
+/* Mode check format text.  */
+
+static void
+mode_check_format_text (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      mode_check_format_text (SUB (p));
+      if (IS (p, FORMAT_PATTERN))
+	{
+	  SOID_T x, y;
+	  a68_make_soid (&x, STRONG, M_FORMAT, 0);
+	  mode_check_enclosed (SUB (NEXT_SUB (p)), &x, &y);
+	  if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING))
+	    a68_cannot_coerce (p, MOID (&y), MOID (&x), STRONG, SAFE_DEFLEXING, ENCLOSED_CLAUSE);
+	}
+      else if (IS (p, GENERAL_PATTERN) && NEXT_SUB (p) != NO_NODE)
+	{
+	  SOID_T x, y;
+	  a68_make_soid (&x, STRONG, M_ROW_INT, 0);
+	  mode_check_enclosed (SUB (NEXT_SUB (p)), &x, &y);
+	  if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING))
+	    a68_cannot_coerce (p, MOID (&y), MOID (&x), STRONG, SAFE_DEFLEXING, ENCLOSED_CLAUSE);
+	}
+      else if (IS (p, DYNAMIC_REPLICATOR))
+	{
+	  SOID_T x, y;
+	  a68_make_soid (&x, STRONG, M_INT, 0);
+	  mode_check_enclosed (SUB (NEXT_SUB (p)), &x, &y);
+	  if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING))
+	    a68_cannot_coerce (p, MOID (&y), MOID (&x), STRONG, SAFE_DEFLEXING, ENCLOSED_CLAUSE);
+	}
+    }
+}
+
+/* Mode check unit.  */
+
+static void
+mode_check_unit (NODE_T *p, SOID_T *x, SOID_T *y)
+{
+  if (p == NO_NODE)
+    return;
+  else if (a68_is_one_of (p, UNIT, TERTIARY, SECONDARY, PRIMARY, STOP))
+    mode_check_unit (SUB (p), x, y);
+  /* Ex primary.  */
+  else if (IS (p, SPECIFICATION))
+    {
+      ATTRIBUTE (p) = mode_check_specification (SUB (p), x, y);
+      a68_warn_for_voiding (p, x, y, ATTRIBUTE (p));
+    }
+  else if (IS (p, CAST))
+    {
+      mode_check_cast (SUB (p), x, y);
+      a68_warn_for_voiding (p, x, y, CAST);
+    }
+  else if (IS (p, DENOTATION))
+    {
+      a68_make_soid (y, SORT (x), MOID (SUB (p)), 0);
+      a68_warn_for_voiding (p, x, y, DENOTATION);
+    }
+  else if (IS (p, IDENTIFIER))
+    {
+      if ((TAX (p) == NO_TAG) && (MOID (p) == NO_MOID))
+	{
+	  int att = a68_first_tag_global (TABLE (p), NSYMBOL (p));
+	  if (att == STOP)
+	    {
+	      (void) a68_add_tag (TABLE (p), IDENTIFIER, p, M_ERROR, NORMAL_IDENTIFIER);
+	      a68_error (p, "tag S has not been declared properly");
+	      MOID (p) = M_ERROR;
+	    }
+	  else
+	    {
+	      TAG_T *z = a68_find_tag_global (TABLE (p), att, NSYMBOL (p));
+	      if (att == IDENTIFIER && z != NO_TAG)
+		MOID (p) = MOID (z);
+	      else
+		{
+		  (void) a68_add_tag (TABLE (p), IDENTIFIER, p, M_ERROR, NORMAL_IDENTIFIER);
+		  a68_error (p, "tag S has not been declared properly");
+		  MOID (p) = M_ERROR;
+		}
+	    }
+	}
+      a68_make_soid (y, SORT (x), MOID (p), 0);
+      a68_warn_for_voiding (p, x, y, IDENTIFIER);
+    }
+  else if (IS (p, ENCLOSED_CLAUSE))
+    mode_check_enclosed (SUB (p), x, y);
+  else if (IS (p, FORMAT_TEXT))
+    {
+      mode_check_format_text (p);
+      a68_make_soid (y, SORT (x), M_FORMAT, 0);
+      a68_warn_for_voiding (p, x, y, FORMAT_TEXT);
+      /* Ex secondary.  */
+    }
+  else if (IS (p, GENERATOR))
+    {
+      mode_check_declarer (SUB (p));
+      a68_make_soid (y, SORT (x), MOID (SUB (p)), 0);
+      a68_warn_for_voiding (p, x, y, GENERATOR);
+    }
+  else if (IS (p, SELECTION))
+    {
+      mode_check_selection (SUB (p), x, y);
+      a68_warn_for_voiding (p, x, y, SELECTION);
+      /* Ex tertiary.  */
+    }
+  else if (IS (p, NIHIL))
+    a68_make_soid (y, STRONG, M_HIP, 0);
+  else if (IS (p, FORMULA))
+    {
+      mode_check_formula (p, x, y);
+      if (!IS_REF (MOID (y)))
+	a68_warn_for_voiding (p, x, y, FORMULA);
+    }
+  else if (a68_is_one_of (p, JUMP, SKIP, STOP))
+    {
+      if (SORT (x) != STRONG)
+	a68_warning (p, 0, "@ should not be in C context", SORT (x));
+      /*  a68_make_soid (y, STRONG, M_HIP, 0);  */
+      a68_make_soid (y, SORT (x), M_HIP, 0);
+    }
+  else if (IS (p, ASSIGNATION))
+    mode_check_assignation (SUB (p), x, y);
+  else if (IS (p, IDENTITY_RELATION))
+    {
+      mode_check_identity_relation (SUB (p), x, y);
+      a68_warn_for_voiding (p, x, y, IDENTITY_RELATION);
+    }
+  else if (IS (p, ROUTINE_TEXT))
+    {
+      mode_check_routine_text (SUB (p), y);
+      a68_make_soid (y, SORT (x), MOID (p), 0);
+      a68_warn_for_voiding (p, x, y, ROUTINE_TEXT);
+    }
+  else if (IS (p, ASSERTION))
+    {
+      mode_check_assertion (SUB (p));
+      a68_make_soid (y, STRONG, M_VOID, 0);
+    }
+  else if (IS (p, AND_FUNCTION))
+    {
+      mode_check_bool_function (SUB (p), x, y);
+      a68_warn_for_voiding (p, x, y, AND_FUNCTION);
+    }
+  else if (IS (p, OR_FUNCTION))
+    {
+      mode_check_bool_function (SUB (p), x, y);
+      a68_warn_for_voiding (p, x, y, OR_FUNCTION);
+    }
+
+  MOID (p) = MOID (y);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-moids-coerce.cc
@@ -0,0 +1,874 @@
+/* Mode coercion driver.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "options.h"
+
+#include "a68.h"
+
+#define A68_INSERT_COERCIONS(n, p, q) a68_make_strong ((n), (p), MOID (q))
+
+/* A few forward references of functions defined below.  */
+
+static void coerce_unit (NODE_T *p, SOID_T *q);
+static void coerce_formula (NODE_T *p, SOID_T *q __attribute__ ((unused)));
+static void coerce_operand (NODE_T *p, SOID_T *q);
+
+/* Coerce bounds.  */
+
+static void
+coerce_bounds (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, UNIT))
+	{
+	  SOID_T q;
+	  a68_make_soid (&q, MEEK, M_INT, 0);
+	  coerce_unit (p, &q);
+	}
+      else
+	coerce_bounds (SUB (p));
+    }
+}
+
+/* Coerce declarer.  */
+
+static void
+coerce_declarer (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, BOUNDS))
+	coerce_bounds (SUB (p));
+      else
+	coerce_declarer (SUB (p));
+    }
+}
+
+/* Coerce identity declaration.  */
+
+static void
+coerce_identity_declaration (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      switch (ATTRIBUTE (p))
+	{
+	case DECLARER:
+	  coerce_declarer (SUB (p));
+	  coerce_identity_declaration (NEXT (p));
+        break;
+	case DEFINING_IDENTIFIER:
+	  {
+	    SOID_T q;
+	    a68_make_soid (&q, STRONG, MOID (p), 0);
+	    coerce_unit (NEXT_NEXT (p), &q);
+	    break;
+	  }
+	default:
+	  coerce_identity_declaration (SUB (p));
+	  coerce_identity_declaration (NEXT (p));
+	  break;
+	}
+    }
+}
+
+/* Coerce variable declaration.  */
+
+static void
+coerce_variable_declaration (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      switch (ATTRIBUTE (p))
+	{
+	case DECLARER:
+	  coerce_declarer (SUB (p));
+	  coerce_variable_declaration (NEXT (p));
+	  break;
+	case DEFINING_IDENTIFIER:
+	  if (a68_whether (p, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP))
+	    {
+	      SOID_T q;
+	      a68_make_soid (&q, STRONG, SUB_MOID (p), 0);
+	      coerce_unit (NEXT_NEXT (p), &q);
+	      break;
+	    }
+	  /* Fallthrough.  */
+	default:
+	  coerce_variable_declaration (SUB (p));
+	  coerce_variable_declaration (NEXT (p));
+	  break;
+	}
+    }
+}
+
+/* Coerce routine text.  */
+
+static void
+coerce_routine_text (NODE_T *p)
+{
+  if (IS (p, PARAMETER_PACK))
+    FORWARD (p);
+  SOID_T w;
+  a68_make_soid (&w, STRONG, MOID (p), 0);
+  coerce_unit (NEXT_NEXT (p), &w);
+}
+
+/* Coerce proc declaration.  */
+
+static void
+coerce_proc_declaration (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, ROUTINE_TEXT))
+    coerce_routine_text (SUB (p));
+  else
+    {
+      coerce_proc_declaration (SUB (p));
+      coerce_proc_declaration (NEXT (p));
+    }
+}
+
+/* Coerce_op_declaration.  */
+
+static void
+coerce_op_declaration (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, DEFINING_OPERATOR))
+    {
+      SOID_T q;
+      a68_make_soid (&q, STRONG, MOID (p), 0);
+      coerce_unit (NEXT_NEXT (p), &q);
+    }
+  else
+    {
+      coerce_op_declaration (SUB (p));
+      coerce_op_declaration (NEXT (p));
+    }
+}
+
+/* Coerce brief op declaration.  */
+
+static void
+coerce_brief_op_declaration (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, DEFINING_OPERATOR))
+    coerce_routine_text (SUB (NEXT_NEXT (p)));
+  else
+    {
+      coerce_brief_op_declaration (SUB (p));
+      coerce_brief_op_declaration (NEXT (p));
+    }
+}
+
+/* Coerce declaration list.  */
+
+static void
+coerce_declaration_list (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      switch (ATTRIBUTE (p))
+	{
+	case IDENTITY_DECLARATION:
+	  coerce_identity_declaration (SUB (p));
+	  break;
+	case VARIABLE_DECLARATION:
+	  coerce_variable_declaration (SUB (p));
+	  break;
+	case MODE_DECLARATION:
+	  coerce_declarer (SUB (p));
+	  break;
+	case PROCEDURE_DECLARATION:
+	case PROCEDURE_VARIABLE_DECLARATION:
+	  coerce_proc_declaration (SUB (p));
+	  break;
+	case BRIEF_OPERATOR_DECLARATION:
+	  coerce_brief_op_declaration (SUB (p));
+	  break;
+	case OPERATOR_DECLARATION:
+	  coerce_op_declaration (SUB (p));
+	  break;
+	default:
+	  coerce_declaration_list (SUB (p));
+	  coerce_declaration_list (NEXT (p));
+	  break;
+	}
+    }
+}
+
+/* Coerce serial.  */
+
+static void
+coerce_serial (NODE_T *p, SOID_T *q, bool k)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, INITIALISER_SERIES))
+    {
+      coerce_serial (SUB (p), q, false);
+      coerce_serial (NEXT (p), q, k);
+    }
+  else if (IS (p, DECLARATION_LIST))
+    coerce_declaration_list (SUB (p));
+  else if (a68_is_one_of (p, LABEL, SEMI_SYMBOL, EXIT_SYMBOL, STOP))
+    coerce_serial (NEXT (p), q, k);
+  else if (a68_is_one_of (p, SERIAL_CLAUSE, ENQUIRY_CLAUSE, STOP))
+    {
+      NODE_T *z = NEXT (p);
+      if (z != NO_NODE)
+	{
+	  if (IS (z, EXIT_SYMBOL) || IS (z, END_SYMBOL) || IS (z, CLOSE_SYMBOL))
+	    coerce_serial (SUB (p), q, true);
+	  else
+	    coerce_serial (SUB (p), q, false);
+	}
+      else
+	coerce_serial (SUB (p), q, true);
+      coerce_serial (NEXT (p), q, k);
+    }
+  else if (IS (p, LABELED_UNIT))
+    coerce_serial (SUB (p), q, k);
+  else if (IS (p, UNIT))
+    {
+      if (k)
+	coerce_unit (p, q);
+      else
+	{
+	  SOID_T strongvoid;
+	  a68_make_soid (&strongvoid, STRONG, M_VOID, 0);
+	  coerce_unit (p, &strongvoid);
+	}
+    }
+}
+
+/* Coerce closed.  */
+
+static void
+coerce_closed (NODE_T *p, SOID_T *q)
+{
+  if (IS (p, SERIAL_CLAUSE))
+    coerce_serial (p, q, true);
+  else if (a68_is_one_of (p, OPEN_SYMBOL, BEGIN_SYMBOL, STOP))
+    coerce_closed (NEXT (p), q);
+}
+
+/* Coerce conditional.  */
+
+static void
+coerce_conditional (NODE_T *p, SOID_T *q)
+{
+  SOID_T w;
+  a68_make_soid (&w, MEEK, M_BOOL, 0);
+  coerce_serial (NEXT_SUB (p), &w, true);
+  FORWARD (p);
+  coerce_serial (NEXT_SUB (p), q, true);
+  if ((FORWARD (p)) != NO_NODE)
+    {
+      if (a68_is_one_of (p, ELSE_PART, CHOICE, STOP))
+	coerce_serial (NEXT_SUB (p), q, true);
+      else if (a68_is_one_of (p, ELIF_PART, BRIEF_ELIF_PART, STOP))
+	coerce_conditional (SUB (p), q);
+    }
+}
+
+/* Coerce unit list.  */
+
+static void
+coerce_unit_list (NODE_T *p, SOID_T *q)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, UNIT_LIST))
+    {
+      coerce_unit_list (SUB (p), q);
+      coerce_unit_list (NEXT (p), q);
+    }
+  else if (a68_is_one_of (p, OPEN_SYMBOL, BEGIN_SYMBOL, COMMA_SYMBOL, STOP))
+    coerce_unit_list (NEXT (p), q);
+  else if (IS (p, UNIT))
+    {
+      coerce_unit (p, q);
+      coerce_unit_list (NEXT (p), q);
+    }
+}
+
+/* Coerce int case.  */
+
+static void
+coerce_int_case (NODE_T *p, SOID_T *q)
+{
+  SOID_T w;
+  a68_make_soid (&w, MEEK, M_INT, 0);
+  coerce_serial (NEXT_SUB (p), &w, true);
+  FORWARD (p);
+  coerce_unit_list (NEXT_SUB (p), q);
+  if ((FORWARD (p)) != NO_NODE)
+    {
+      if (a68_is_one_of (p, OUT_PART, CHOICE, STOP))
+	coerce_serial (NEXT_SUB (p), q, true);
+      else if (a68_is_one_of (p, CASE_OUSE_PART, BRIEF_OUSE_PART, STOP))
+	coerce_int_case (SUB (p), q);
+    }
+}
+
+/* Coerce spec unit list.  */
+
+static void
+coerce_spec_unit_list (NODE_T *p, SOID_T *q)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (a68_is_one_of (p, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT, STOP))
+	coerce_spec_unit_list (SUB (p), q);
+      else if (IS (p, UNIT))
+	coerce_unit (p, q);
+    }
+}
+
+/* Coerce united case.  */
+
+static void
+coerce_united_case (NODE_T *p, SOID_T *q)
+{
+  SOID_T w;
+  a68_make_soid (&w, MEEK, MOID (SUB (p)), 0);
+  coerce_serial (NEXT_SUB (p), &w, true);
+  FORWARD (p);
+  coerce_spec_unit_list (NEXT_SUB (p), q);
+  if ((FORWARD (p)) != NO_NODE)
+    {
+      if (a68_is_one_of (p, OUT_PART, CHOICE, STOP))
+	coerce_serial (NEXT_SUB (p), q, true);
+      else if (a68_is_one_of (p, CONFORMITY_OUSE_PART, BRIEF_CONFORMITY_OUSE_PART, STOP))
+	coerce_united_case (SUB (p), q);
+    }
+}
+
+/* Coerce loop.  */
+
+static void
+coerce_loop (NODE_T *p)
+{
+  if (IS (p, FOR_PART))
+    coerce_loop (NEXT (p));
+  else if (a68_is_one_of (p, FROM_PART, BY_PART, TO_PART, STOP))
+    {
+      SOID_T w;
+      a68_make_soid (&w, MEEK, M_INT, 0);
+      coerce_unit (NEXT_SUB (p), &w);
+      coerce_loop (NEXT (p));
+    }
+  else if (IS (p, WHILE_PART))
+    {
+      SOID_T w;
+      a68_make_soid (&w, MEEK, M_BOOL, 0);
+      coerce_serial (NEXT_SUB (p), &w, true);
+      coerce_loop (NEXT (p));
+    }
+  else if (a68_is_one_of (p, DO_PART, ALT_DO_PART, STOP))
+    {
+      SOID_T w;
+      NODE_T *do_p = NEXT_SUB (p);
+      a68_make_soid (&w, STRONG, M_VOID, 0);
+      coerce_serial (do_p, &w, true);
+    }
+}
+
+/* Coerce struct display.  */
+
+static void
+coerce_struct_display (PACK_T **r, NODE_T *p)
+{
+  if (p == NO_NODE)
+    return;
+  else if (IS (p, UNIT_LIST))
+    {
+      coerce_struct_display (r, SUB (p));
+      coerce_struct_display (r, NEXT (p));
+    }
+  else if (a68_is_one_of (p, OPEN_SYMBOL, BEGIN_SYMBOL, COMMA_SYMBOL, STOP))
+    coerce_struct_display (r, NEXT (p));
+  else if (IS (p, UNIT))
+    {
+      SOID_T s;
+      a68_make_soid (&s, STRONG, MOID (*r), 0);
+      coerce_unit (p, &s);
+      FORWARD (*r);
+      coerce_struct_display (r, NEXT (p));
+    }
+}
+
+/* Coerce collateral.  */
+
+static void
+coerce_collateral (NODE_T *p, SOID_T *q)
+{
+  if (!(a68_whether (p, BEGIN_SYMBOL, END_SYMBOL, STOP)
+	|| a68_whether (p, OPEN_SYMBOL, CLOSE_SYMBOL, STOP)))
+    {
+      if (IS (MOID (q), STRUCT_SYMBOL))
+	{
+	  PACK_T *t = PACK (MOID (q));
+	  coerce_struct_display (&t, p);
+	}
+      else if (IS_FLEX (MOID (q)))
+	{
+	  SOID_T w;
+	  a68_make_soid (&w, STRONG, SLICE (SUB_MOID (q)), 0);
+	  coerce_unit_list (p, &w);
+	}
+      else if (IS_ROW (MOID (q)))
+	{
+	  SOID_T w;
+	  a68_make_soid (&w, STRONG, SLICE (MOID (q)), 0);
+	  coerce_unit_list (p, &w);
+	}
+      else
+	{
+	  /* if (MOID (q) != M_VOID).  */
+	  coerce_unit_list (p, q);
+	}
+    }
+}
+
+/* Coerce_enclosed.  */
+
+static void
+coerce_enclosed (NODE_T *p, SOID_T *q)
+{
+  if (IS (p, ENCLOSED_CLAUSE))
+    coerce_enclosed (SUB (p), q);
+  else if (IS (p, CLOSED_CLAUSE))
+    coerce_closed (SUB (p), q);
+  else if (IS (p, COLLATERAL_CLAUSE))
+    coerce_collateral (SUB (p), q);
+  else if (IS (p, PARALLEL_CLAUSE))
+    coerce_collateral (SUB (NEXT_SUB (p)), q);
+  else if (IS (p, CONDITIONAL_CLAUSE))
+    coerce_conditional (SUB (p), q);
+  else if (IS (p, CASE_CLAUSE))
+    coerce_int_case (SUB (p), q);
+  else if (IS (p, CONFORMITY_CLAUSE))
+    coerce_united_case (SUB (p), q);
+  else if (IS (p, LOOP_CLAUSE))
+    coerce_loop (SUB (p));
+
+  MOID (p) = a68_depref_rows (MOID (p), MOID (q));
+}
+
+/* Get monad moid.  */
+
+static MOID_T *
+get_monad_moid (NODE_T *p)
+{
+  if (TAX (p) != NO_TAG && TAX (p) != A68_PARSER (error_tag))
+    {
+      MOID (p) = MOID (TAX (p));
+      return MOID (PACK (MOID (p)));
+    }
+  else
+    return M_ERROR;
+}
+
+/* Coerce monad oper.  */
+
+static void
+coerce_monad_oper (NODE_T *p, SOID_T *q)
+{
+  if (p != NO_NODE)
+    {
+      SOID_T z;
+      a68_make_soid (&z, FIRM, MOID (PACK (MOID (TAX (p)))), 0);
+      A68_INSERT_COERCIONS (NEXT (p), MOID (q), &z);
+    }
+}
+
+/* Coerce monad formula.  */
+
+static void
+coerce_monad_formula (NODE_T *p)
+{
+  SOID_T e;
+  a68_make_soid (&e, STRONG, get_monad_moid (p), 0);
+  coerce_operand (NEXT (p), &e);
+  coerce_monad_oper (p, &e);
+}
+
+/* Coerce operand.  */
+
+static void
+coerce_operand (NODE_T *p, SOID_T *q)
+{
+  if (IS (p, MONADIC_FORMULA))
+    {
+      coerce_monad_formula (SUB (p));
+      if (MOID (p) != MOID (q))
+	{
+	  a68_make_sub (p, p, FORMULA);
+	  A68_INSERT_COERCIONS (p, MOID (p), q);
+	  a68_make_sub (p, p, TERTIARY);
+	}
+      MOID (p) = a68_depref_rows (MOID (p), MOID (q));
+    }
+  else if (IS (p, FORMULA))
+    {
+      coerce_formula (SUB (p), q);
+      A68_INSERT_COERCIONS (p, MOID (p), q);
+      MOID (p) = a68_depref_rows (MOID (p), MOID (q));
+    }
+  else if (IS (p, SECONDARY))
+    {
+      coerce_unit (SUB (p), q);
+      MOID (p) = MOID (SUB (p));
+    }
+}
+
+/* Coerce formula.  */
+
+static void
+coerce_formula (NODE_T *p, SOID_T *q __attribute__ ((unused)))
+{
+  if (IS (p, MONADIC_FORMULA) && NEXT (p) == NO_NODE)
+    coerce_monad_formula (SUB (p));
+  else
+    {
+      if (TAX (NEXT (p)) != NO_TAG && TAX (NEXT (p)) != A68_PARSER (error_tag))
+	{
+	  SOID_T s;
+	  NODE_T *op = NEXT (p), *nq = NEXT_NEXT (p);
+	  MOID_T *w = MOID (op);
+	  MOID_T *u = MOID (PACK (w)), *v = MOID (NEXT (PACK (w)));
+	  a68_make_soid (&s, STRONG, u, 0);
+	  coerce_operand (p, &s);
+	  a68_make_soid (&s, STRONG, v, 0);
+	  coerce_operand (nq, &s);
+	}
+    }
+}
+
+/* Coerce assignation.  */
+
+static void
+coerce_assignation (NODE_T *p)
+{
+  SOID_T w;
+  a68_make_soid (&w, SOFT, MOID (p), 0);
+  coerce_unit (SUB (p), &w);
+  a68_make_soid (&w, STRONG, SUB_MOID (p), 0);
+  coerce_unit (NEXT_NEXT (p), &w);
+}
+
+/* Coerce relation.  */
+
+static void
+coerce_relation (NODE_T *p)
+{
+  SOID_T w;
+  a68_make_soid (&w, STRONG, MOID (p), 0);
+  coerce_unit (SUB (p), &w);
+  a68_make_soid (&w, STRONG, MOID (NEXT_NEXT (p)), 0);
+  coerce_unit (SUB (NEXT_NEXT (p)), &w);
+}
+
+/* Coerce bool function.  */
+
+static void
+coerce_bool_function (NODE_T *p)
+{
+  SOID_T w;
+  a68_make_soid (&w, STRONG, M_BOOL, 0);
+  coerce_unit (SUB (p), &w);
+  coerce_unit (SUB (NEXT_NEXT (p)), &w);
+}
+
+/* Coerce assertion.  */
+
+static void
+coerce_assertion (NODE_T *p)
+{
+  SOID_T w;
+  a68_make_soid (&w, MEEK, M_BOOL, 0);
+  coerce_enclosed (SUB_NEXT (p), &w);
+}
+
+/* Coerce selection.  */
+
+static void
+coerce_selection (NODE_T * p)
+{
+  SOID_T w;
+  a68_make_soid (&w, STRONG, MOID (NEXT (p)), 0);
+  coerce_unit (SUB_NEXT (p), &w);
+}
+
+/* Coerce cast.  */
+
+static void
+coerce_cast (NODE_T * p)
+{
+  coerce_declarer (p);
+  SOID_T w;
+  a68_make_soid (&w, STRONG, MOID (p), 0);
+  coerce_enclosed (NEXT (p), &w);
+}
+
+/* Coerce argument list.  */
+
+static void
+coerce_argument_list (PACK_T **r, NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, ARGUMENT_LIST))
+	coerce_argument_list (r, SUB (p));
+      else if (IS (p, UNIT))
+	{
+	  SOID_T s;
+	  a68_make_soid (&s, STRONG, MOID (*r), 0);
+	  coerce_unit (p, &s);
+	  FORWARD (*r);
+	}
+      else if (IS (p, TRIMMER))
+	FORWARD (*r);
+    }
+}
+
+/* Coerce call.  */
+
+static void
+coerce_call (NODE_T *p)
+{
+  MOID_T *proc = MOID (p);
+  SOID_T w;
+  a68_make_soid (&w, MEEK, proc, 0);
+  coerce_unit (SUB (p), &w);
+  FORWARD (p);
+  PACK_T *t = PACK (proc);
+  coerce_argument_list (&t, SUB (p));
+}
+
+/* Coerce meek int.  */
+
+static void
+coerce_meek_int (NODE_T *p)
+{
+  SOID_T x;
+  a68_make_soid (&x, MEEK, M_INT, 0);
+  coerce_unit (p, &x);
+}
+
+/* Coerce trimmer.  */
+
+static void
+coerce_trimmer (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, UNIT))
+	{
+	  coerce_meek_int (p);
+	  coerce_trimmer (NEXT (p));
+	}
+      else
+	coerce_trimmer (NEXT (p));
+    }
+}
+
+/* Coerce indexer.  */
+
+static void
+coerce_indexer (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, TRIMMER))
+	coerce_trimmer (SUB (p));
+      else if (IS (p, UNIT))
+	coerce_meek_int (p);
+      else
+	{
+	  coerce_indexer (SUB (p));
+	  coerce_indexer (NEXT (p));
+	}
+    }
+}
+
+/* Coerce_slice.  */
+
+static void
+coerce_slice (NODE_T *p)
+{
+  SOID_T w;
+  MOID_T *row = MOID (p);
+  a68_make_soid (&w, STRONG, row, 0);
+  coerce_unit (SUB (p), &w);
+  coerce_indexer (SUB_NEXT (p));
+}
+
+/* Coerce format text.  */
+
+static void
+coerce_format_text (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      coerce_format_text (SUB (p));
+      if (IS (p, FORMAT_PATTERN))
+	{
+	  SOID_T x;
+	  a68_make_soid (&x, STRONG, M_FORMAT, 0);
+	  coerce_enclosed (SUB (NEXT_SUB (p)), &x);
+	}
+      else if (IS (p, GENERAL_PATTERN) && NEXT_SUB (p) != NO_NODE)
+	{
+	  SOID_T x;
+	  a68_make_soid (&x, STRONG, M_ROW_INT, 0);
+	  coerce_enclosed (SUB (NEXT_SUB (p)), &x);
+	}
+      else if (IS (p, DYNAMIC_REPLICATOR))
+	{
+	  SOID_T x;
+	  a68_make_soid (&x, STRONG, M_INT, 0);
+	  coerce_enclosed (SUB (NEXT_SUB (p)), &x);
+	}
+    }
+}
+
+/* Coerce unit.  */
+
+static void
+coerce_unit (NODE_T *p, SOID_T *q)
+{
+  if (p == NO_NODE)
+    return;
+  else if (a68_is_one_of (p, UNIT, TERTIARY, SECONDARY, PRIMARY, STOP))
+    {
+      coerce_unit (SUB (p), q);
+      MOID (p) = MOID (SUB (p));
+      /* Ex primary.  */
+    }
+  else if (IS (p, CALL))
+    {
+      coerce_call (SUB (p));
+      A68_INSERT_COERCIONS (p, MOID (p), q);
+    }
+  else if (IS (p, SLICE))
+    {
+      coerce_slice (SUB (p));
+      A68_INSERT_COERCIONS (p, MOID (p), q);
+    }
+  else if (IS (p, CAST))
+    {
+      coerce_cast (SUB (p));
+      A68_INSERT_COERCIONS (p, MOID (p), q);
+    }
+  else if (a68_is_one_of (p, DENOTATION, IDENTIFIER, STOP))
+    A68_INSERT_COERCIONS (p, MOID (p), q);
+  else if (IS (p, FORMAT_TEXT))
+    {
+      coerce_format_text (SUB (p));
+      A68_INSERT_COERCIONS (p, MOID (p), q);
+    }
+  else if (IS (p, ENCLOSED_CLAUSE))
+    {
+      coerce_enclosed (p, q);
+      /* Ex secondary.  */
+    }
+  else if (IS (p, SELECTION))
+    {
+      coerce_selection (SUB (p));
+      A68_INSERT_COERCIONS (p, MOID (p), q);
+    }
+  else if (IS (p, GENERATOR))
+    {
+      coerce_declarer (SUB (p));
+      A68_INSERT_COERCIONS (p, MOID (p), q);
+      /* Ex tertiary.  */
+    }
+  else if (IS (p, NIHIL))
+    {
+      if (ATTRIBUTE (MOID (q)) != REF_SYMBOL && MOID (q) != M_VOID)
+	a68_error (p, "context does not require a name");
+      MOID (p) = a68_depref_rows (MOID (p), MOID (q));
+    }
+  else if (IS (p, FORMULA))
+    {
+      coerce_formula (SUB (p), q);
+      A68_INSERT_COERCIONS (p, MOID (p), q);
+    }
+  else if (IS (p, JUMP))
+    {
+      if (MOID (q) == M_PROC_VOID)
+	a68_make_sub (p, p, PROCEDURING);
+      MOID (p) = a68_depref_rows (MOID (p), MOID (q));
+    }
+  else if (IS (p, SKIP))
+    MOID (p) = a68_depref_rows (MOID (p), MOID (q));
+  else if (IS (p, ASSIGNATION))
+    {
+      coerce_assignation (SUB (p));
+      A68_INSERT_COERCIONS (p, MOID (p), q);
+      MOID (p) = a68_depref_rows (MOID (p), MOID (q));
+    }
+  else if (IS (p, IDENTITY_RELATION))
+    {
+      coerce_relation (SUB (p));
+      A68_INSERT_COERCIONS (p, MOID (p), q);
+    }
+  else if (IS (p, ROUTINE_TEXT))
+    {
+      coerce_routine_text (SUB (p));
+      A68_INSERT_COERCIONS (p, MOID (p), q);
+    }
+  else if (a68_is_one_of (p, AND_FUNCTION, OR_FUNCTION, STOP))
+    {
+      coerce_bool_function (SUB (p));
+      A68_INSERT_COERCIONS (p, MOID (p), q);
+    }
+  else if (IS (p, ASSERTION))
+    {
+      coerce_assertion (SUB (p));
+      A68_INSERT_COERCIONS (p, MOID (p), q);
+    }
+}
+
+/* Driver for coercion insertions.  */
+
+void
+a68_coercion_inserter (NODE_T *p)
+{
+  if (IS (p, PARTICULAR_PROGRAM))
+    {
+      SOID_T q;
+      a68_make_soid (&q, STRONG, M_VOID, 0);
+      coerce_enclosed (SUB (p), &q);
+    }
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-moids-equivalence.cc
@@ -0,0 +1,174 @@
+/* Prove equivalence of modes.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "a68.h"
+
+/* Routines for establishing equivalence of modes.
+   After I made this mode equivalencer (in 1993), I found:
+
+   Algol Bulletin 30.3.3 C.H.A. Koster: On infinite modes, 86-89 [1969],
+
+   which essentially concurs with this test on mode equivalence I wrote.
+   It is elementary logic anyway: prove equivalence, assuming equivalence.  */
+
+/* Forward declarations of some of the functions defined below.  */
+
+static bool are_modes_equivalent (MOID_T * a, MOID_T * b);
+
+/* Whether packs are equivalent, same sequence of equivalence modes.  */
+
+static bool
+are_packs_equivalent (PACK_T *s, PACK_T *t)
+{
+  for (; s != NO_PACK && t != NO_PACK; s = s->next, t = t->next)
+    {
+      if (!are_modes_equivalent (MOID (s), MOID (t)))
+	return false;
+      if (TEXT (s) != TEXT (t))
+	return false;
+    }
+
+  return s == NO_PACK && t == NO_PACK;
+}
+
+/* Whether packs are subsets.  */
+
+static bool
+is_united_subset (PACK_T *s, PACK_T *t)
+{
+  /* For all modes in 's' there must be an equivalent in 't'.  */
+  for (PACK_T *p = s; p != NO_PACK; p = p->next)
+    {
+      bool f = false;
+      for (PACK_T *q = t; q != NO_PACK && !f; q = q->next)
+	f = are_modes_equivalent (MOID (p), MOID (q));
+
+      if (!f)
+	return false;
+    }
+
+  return true;
+}
+
+/* Whether packs are subsets.  */
+
+static bool
+are_united_packs_equivalent (PACK_T *s, PACK_T *t)
+{
+  return is_united_subset (s, t) && is_united_subset (t, s);
+}
+
+/* Whether moids A and B are structurally equivalent.  */
+
+static bool
+are_modes_equivalent (MOID_T * a, MOID_T * b)
+{
+  /* First lets try some cheap heuristics.  */
+
+  if (a == NO_MOID || b == NO_MOID)
+    /* Modes can be NO_MOID in partial argument lists.  */
+    return false;
+  else if (a == M_ERROR || b == M_ERROR)
+    return false;
+  else if (a == b)
+    return true;
+  else if (ATTRIBUTE (a) != ATTRIBUTE (b))
+    return false;
+  else if (DIM (a) != DIM (b))
+    return false;
+  else if (IS (a, STANDARD))
+    return (a == b);
+  else if (EQUIVALENT (a) == b || EQUIVALENT (b) == a)
+    return true;
+  else if (a68_is_postulated_pair (A68 (top_postulate), a, b)
+	   || a68_is_postulated_pair (A68 (top_postulate), b, a))
+    return true;
+  else if (IS (a, INDICANT))
+    {
+      if (NODE (a) == NO_NODE || NODE (b) == NO_NODE)
+	return false;
+      else
+	return NODE (a) == NODE (b);
+    }
+
+  /* Investigate structure.  */
+
+  /* We now know that 'a' and 'b' have same attribute, dimension, ...  */
+  if (IS (a, REF_SYMBOL))
+    /* REF MODE  */
+    return are_modes_equivalent (a->sub, b->sub);
+  else if (IS (a, ROW_SYMBOL))
+    /* [] MODE  */
+    return are_modes_equivalent (a->sub, b->sub);
+  else if (IS (a, FLEX_SYMBOL))
+    /* FLEX [...] MODE  */
+    return are_modes_equivalent (a->sub, b->sub);
+  else if (IS (a, STRUCT_SYMBOL))
+    {
+      /* STRUCT (...)  */
+      POSTULATE_T *save = A68 (top_postulate);
+      a68_make_postulate (&A68 (top_postulate), a, b);
+      bool z = are_packs_equivalent (PACK (a), PACK (b));
+      a68_free_postulate_list (A68 (top_postulate), save);
+      A68 (top_postulate) = save;
+      return z;
+    }
+  else if (IS (a, UNION_SYMBOL))
+    /* UNION (...)  */
+    return are_united_packs_equivalent (PACK (a), PACK (b));
+  else if (IS (a, PROC_SYMBOL) && PACK (a) == NO_PACK && PACK (b) == NO_PACK)
+    /* PROC MOID  */
+    return are_modes_equivalent (a->sub, b->sub);
+  else if (IS (a, PROC_SYMBOL) && PACK (a) != NO_PACK && PACK (b) != NO_PACK)
+    {
+      /* PROC (...) MOID  */
+      POSTULATE_T *save = A68 (top_postulate);
+      a68_make_postulate (&A68 (top_postulate), a, b);
+      bool z = are_modes_equivalent (a->sub, b->sub);
+      if (z)
+	z = are_packs_equivalent (PACK (a), PACK (b));
+      a68_free_postulate_list (A68 (top_postulate), save);
+      A68 (top_postulate) = save;
+      return z;
+    }
+  else if (IS (a, SERIES_MODE) || IS (a, STOWED_MODE))
+    /* Modes occurring in displays.  */
+    return are_packs_equivalent (PACK (a), PACK (b));
+
+  return false;
+}
+
+//! @brief Whether two modes are structurally equivalent.
+
+bool
+a68_prove_moid_equivalence (MOID_T *p, MOID_T *q)
+{
+// Prove two modes to be equivalent under assumption that they indeed are.
+  POSTULATE_T *save = A68 (top_postulate);
+  bool z = are_modes_equivalent (p, q);
+  a68_free_postulate_list (A68 (top_postulate), save);
+  A68 (top_postulate) = save;
+  return z;
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-prelude.cc
@@ -0,0 +1,1493 @@
+/* Standard prelude definitions.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "a68.h"
+
+#define A68_STD true
+#define A68_EXT false
+
+/* ALGOL68C type procs. */
+
+#define A68C_DEFIO(name, mode)					\
+  do								\
+    {								\
+      m = a68_proc (MODE (mode), M_REF_FILE, NO_MOID);		\
+      a68_idf (A68_EXT, "get" #name, m);			\
+      m = a68_proc (M_VOID, M_REF_FILE, MODE (mode), NO_MOID);	\
+      a68_idf (A68_EXT, "put" #name, m);			\
+      m = a68_proc (MODE (mode), NO_MOID);			\
+      a68_idf (A68_EXT, "read" #name, m);			\
+      m = a68_proc (M_VOID, MODE (mode), NO_MOID);		\
+      a68_idf (A68_EXT, "print" #name, m);			\
+    }								\
+  while (0)
+
+/* Enter tag in standenv symbol table.  */
+
+static void
+add_a68_standenv (bool portable, int a, NODE_T* n, char *c, MOID_T *m,
+		  int p, LOWERER_T l = NO_LOWERER)
+{
+#define INSERT_TAG(l, n) \
+  do {			 \
+    NEXT (n) = *(l);	 \
+    *(l) = (n);		 \
+  } while (0)
+
+  TAG_T *new_one = a68_new_tag ();
+
+  PROCEDURE_LEVEL (INFO (n)) = 0;
+  USE (new_one) = false;
+  HEAP (new_one) = HEAP_SYMBOL;
+  TAG_TABLE (new_one) = A68_STANDENV;
+  NODE (new_one) = n;
+  VALUE (new_one) = (c != NO_TEXT ? TEXT (a68_add_token (&A68 (top_token), c)) : NO_TEXT);
+  PRIO (new_one) = p;
+  TAX_TREE_DECL (new_one) = NULL;
+  LOWERER (new_one) = l;
+  UNIT (new_one) = NULL;
+  PORTABLE (new_one) = portable;
+  MOID (new_one) = m;
+  NEXT (new_one) = NO_TAG;
+  if (a == IDENTIFIER)
+    INSERT_TAG (&IDENTIFIERS (A68_STANDENV), new_one);
+  else if (a == OP_SYMBOL)
+    INSERT_TAG (&OPERATORS (A68_STANDENV), new_one);
+  else if (a == PRIO_SYMBOL)
+    INSERT_TAG (&PRIO (A68_STANDENV), new_one);
+  else if (a == INDICANT)
+    INSERT_TAG (&INDICANTS (A68_STANDENV), new_one);
+  else if (a == LABEL)
+    INSERT_TAG (&LABELS (A68_STANDENV), new_one);
+#undef INSERT_TAG
+}
+
+/* Compose PROC moid from arguments - first result, than arguments.  */
+
+static MOID_T *
+a68_proc (MOID_T *m, ...)
+{
+  PACK_T *p = NO_PACK, *q = NO_PACK;
+  MOID_T *y;
+
+  va_list attribute;
+  va_start (attribute, m);
+  while ((y = va_arg (attribute, MOID_T *)) != NO_MOID)
+    {
+      PACK_T *new_one = a68_new_pack ();
+
+      MOID (new_one) = y;
+      TEXT (new_one) = NO_TEXT;
+      NEXT (new_one) = NO_PACK;
+      if (q != NO_PACK)
+	NEXT (q) = new_one;
+      else
+	p = new_one;
+      q = new_one;
+    }
+
+  va_end (attribute);
+  return a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL,
+		   a68_count_pack_members (p), NO_NODE, m, p);
+}
+
+/* Enter an identifier in standenv.  */
+
+static void
+a68_idf (bool portable, const char *n, MOID_T *m, LOWERER_T l = NO_LOWERER)
+{
+  add_a68_standenv (portable, IDENTIFIER,
+		    a68_some_node (TEXT (a68_add_token (&A68 (top_token), n))),
+		    NO_TEXT, m, 0, l);
+}
+
+/* Enter a moid in standenv.  */
+
+static void
+a68_mode (int p, const char *t, MOID_T **m)
+{
+  (*m) = a68_add_mode (&TOP_MOID (&A68_JOB),
+		   STANDARD, p,
+		   a68_some_node (TEXT (a68_find_keyword (A68 (top_keyword), t))),
+		   NO_MOID, NO_PACK);
+}
+
+/* Enter a priority in standenv.  */
+
+static void
+a68_prio (const char *p, int b)
+{
+  add_a68_standenv (true, PRIO_SYMBOL,
+		    a68_some_node (TEXT (a68_add_token (&A68 (top_token), p))),
+		    NO_TEXT, NO_MOID, b, NO_LOWERER);
+}
+
+/* Enter operator in standenv.  */
+
+static void
+a68_op (bool portable, const char *n, MOID_T *m, LOWERER_T l = NO_LOWERER)
+{
+  add_a68_standenv (portable, OP_SYMBOL,
+		    a68_some_node (TEXT (a68_add_token (&A68 (top_token), n))),
+		    NO_TEXT, m, 0, l);
+}
+
+/* Enter standard modes in standenv.  */
+
+static void
+stand_moids (void)
+{
+  /* Primitive A68 moids.  */
+  a68_mode (0, "VOID", &M_VOID);
+  /* Standard precision.  */
+  a68_mode (0, "INT", &M_INT);
+  a68_mode (0, "REAL", &M_REAL);
+  a68_mode (0, "COMPL", &M_COMPLEX);
+  a68_mode (0, "BITS", &M_BITS);
+  a68_mode (0, "BYTES", &M_BYTES);
+  /* Multiple precision.  */
+  a68_mode (-2, "INT", &M_SHORT_SHORT_INT);
+  a68_mode (-2, "BITS", &M_SHORT_SHORT_BITS);
+  a68_mode (-1, "INT", &M_SHORT_INT);
+  a68_mode (-1, "BITS", &M_SHORT_BITS);
+  a68_mode (1, "INT", &M_LONG_INT);
+  a68_mode (1, "REAL", &M_LONG_REAL);
+  a68_mode (1, "COMPL", &M_LONG_COMPLEX);
+  a68_mode (1, "BITS", &M_LONG_BITS);
+  a68_mode (1, "BYTES", &M_LONG_BYTES);
+  a68_mode (2, "REAL", &M_LONG_LONG_REAL);
+  a68_mode (2, "INT", &M_LONG_LONG_INT);
+  a68_mode (2, "BITS", &M_LONG_LONG_BITS);
+  a68_mode (2, "COMPL", &M_LONG_LONG_COMPLEX);
+  /* Other.  */
+  a68_mode (0, "BOOL", &M_BOOL);
+  a68_mode (0, "CHAR", &M_CHAR);
+  a68_mode (0, "STRING", &M_STRING);
+  a68_mode (0, "FILE", &M_FILE);
+  a68_mode (0, "CHANNEL", &M_CHANNEL);
+  a68_mode (0, "SEMA", &M_SEMA);
+  /* Rows.  */
+  M_ROWS = a68_add_mode (&TOP_MOID (&A68_JOB), ROWS_SYMBOL, 0, NO_NODE, NO_MOID, NO_PACK);
+  /* REFs.  */
+  M_REF_INT = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_INT, NO_PACK);
+  M_REF_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_REAL, NO_PACK);
+  M_REF_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_COMPLEX, NO_PACK);
+  M_REF_BITS = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_BITS, NO_PACK);
+  M_REF_BYTES = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_BYTES, NO_PACK);
+  /* Multiple precision.  */
+  M_REF_LONG_INT = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_INT, NO_PACK);
+  M_REF_LONG_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_REAL, NO_PACK);
+  M_REF_LONG_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_COMPLEX, NO_PACK);
+  M_REF_LONG_LONG_INT = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_LONG_INT, NO_PACK);
+  M_REF_LONG_LONG_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_LONG_REAL, NO_PACK);
+  M_REF_LONG_LONG_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_LONG_COMPLEX, NO_PACK);
+  M_REF_LONG_BITS = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_BITS, NO_PACK);
+  M_REF_LONG_LONG_BITS = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_LONG_BITS, NO_PACK);
+  M_REF_LONG_BYTES = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_BYTES, NO_PACK);
+  M_REF_SHORT_INT = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_SHORT_INT, NO_PACK);
+  M_REF_SHORT_SHORT_INT = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_SHORT_SHORT_INT, NO_PACK
+);
+  M_REF_SHORT_BITS = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_SHORT_BITS, NO_PACK);
+  M_REF_SHORT_SHORT_BITS = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_SHORT_SHORT_BITS, NO_PACK);
+  /* Other.  */
+  M_REF_BOOL = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_BOOL, NO_PACK);
+  M_REF_CHAR = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_CHAR, NO_PACK);
+  M_REF_FILE = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_FILE, NO_PACK);
+  M_REF_REF_FILE = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_REF_FILE, NO_PACK);
+  /* [] INT.  */
+  M_ROW_INT = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_INT, NO_PACK);
+  HAS_ROWS (M_ROW_INT) = true;
+  SLICE (M_ROW_INT) = M_INT;
+  M_REF_ROW_INT = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_ROW_INT, NO_PACK);
+  NAME (M_REF_ROW_INT) = M_REF_INT;
+  /* [] REAL.  */
+  M_ROW_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_REAL, NO_PACK);
+  HAS_ROWS (M_ROW_REAL) = true;
+  SLICE (M_ROW_REAL) = M_REAL;
+  M_REF_ROW_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_ROW_REAL, NO_PACK);
+  NAME (M_REF_ROW_REAL) = M_REF_REAL;
+  /* [,] REAL.  */
+  M_ROW_ROW_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 2, NO_NODE, M_REAL, NO_PACK);
+  HAS_ROWS (M_ROW_ROW_REAL) = true;
+  SLICE (M_ROW_ROW_REAL) = M_ROW_REAL;
+  M_REF_ROW_ROW_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_ROW_ROW_REAL, NO_PACK);
+  NAME (M_REF_ROW_ROW_REAL) = M_REF_ROW_REAL;
+  /* [] COMPLEX.  */
+  M_ROW_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_COMPLEX, NO_PACK);
+  HAS_ROWS (M_ROW_COMPLEX) = true;
+  SLICE (M_ROW_COMPLEX) = M_COMPLEX;
+  M_REF_ROW_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_ROW_COMPLEX, NO_PACK);
+  NAME (M_REF_ROW_COMPLEX) = M_REF_COMPLEX;
+  /* [,] COMPLEX.  */
+  M_ROW_ROW_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 2, NO_NODE, M_COMPLEX, NO_PACK);
+  HAS_ROWS (M_ROW_ROW_COMPLEX) = true;
+  SLICE (M_ROW_ROW_COMPLEX) = M_ROW_COMPLEX;
+  M_REF_ROW_ROW_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_ROW_ROW_COMPLEX, NO_PACK);
+  NAME (M_REF_ROW_ROW_COMPLEX) = M_REF_ROW_COMPLEX;
+  /* [] BOOL.  */
+  M_ROW_BOOL = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_BOOL, NO_PACK);
+  HAS_ROWS (M_ROW_BOOL) = true;
+  SLICE (M_ROW_BOOL) = M_BOOL;
+  /* FLEX [] BOOL.  */
+  MOID_T *m = a68_add_mode (&TOP_MOID (&A68_JOB), FLEX_SYMBOL, 0, NO_NODE, M_ROW_BOOL, NO_PACK);
+  HAS_ROWS (m) = true;
+  M_FLEX_ROW_BOOL = m;
+  /* [] BITS.  */
+  M_ROW_BITS = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_BITS, NO_PACK);
+  HAS_ROWS (M_ROW_BITS) = true;
+  SLICE (M_ROW_BITS) = M_BITS;
+  /* [] CHAR.  */
+  M_ROW_CHAR = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_CHAR, NO_PACK);
+  HAS_ROWS (M_ROW_CHAR) = true;
+  SLICE (M_ROW_CHAR) = M_CHAR;
+  /* [][] CHAR.  */
+  M_ROW_ROW_CHAR = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_ROW_CHAR, NO_PACK);
+  HAS_ROWS (M_ROW_ROW_CHAR) = true;
+  SLICE (M_ROW_ROW_CHAR) = M_ROW_CHAR;
+  /* MODE STRING = FLEX [] CHAR.  */
+  m = a68_add_mode (&TOP_MOID (&A68_JOB), FLEX_SYMBOL, 0, NO_NODE, M_ROW_CHAR, NO_PACK);
+  HAS_ROWS (m) = true;
+  M_FLEX_ROW_CHAR = m;
+  EQUIVALENT (M_STRING) = m;
+  /* REF [] CHAR.  */
+  M_REF_ROW_CHAR = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_ROW_CHAR, NO_PACK);
+  NAME (M_REF_ROW_CHAR) = M_REF_CHAR;
+  /* PROC [] CHAR.  */
+  M_PROC_ROW_CHAR = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, 0, NO_NODE, M_ROW_CHAR, NO_PACK);
+  /* REF STRING = REF FLEX [] CHAR.  */
+  M_REF_STRING = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, EQUIVALENT (M_STRING), NO_PACK);
+  NAME (M_REF_STRING) = M_REF_CHAR;
+  DEFLEXED (M_REF_STRING) = M_REF_ROW_CHAR;
+  /* [] STRING.  */
+  M_ROW_STRING = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_STRING, NO_PACK);
+  HAS_ROWS (M_ROW_STRING) = true;
+  SLICE (M_ROW_STRING) = M_STRING;
+  DEFLEXED (M_ROW_STRING) = M_ROW_ROW_CHAR;
+  /* PROC STRING.  */
+  M_PROC_STRING = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, 0, NO_NODE, M_STRING, NO_PACK);
+  DEFLEXED (M_PROC_STRING) = M_PROC_ROW_CHAR;
+  /* COMPLEX.  */
+  PACK_T *z = NO_PACK;
+  (void) a68_add_mode_to_pack (&z, M_REAL, TEXT (a68_add_token (&A68 (top_token), "im")), NO_NODE);
+  (void) a68_add_mode_to_pack (&z, M_REAL, TEXT (a68_add_token (&A68 (top_token), "re")), NO_NODE);
+  m = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z);
+  EQUIVALENT (M_COMPLEX) = m;
+  z = NO_PACK;
+  (void) a68_add_mode_to_pack (&z, M_REF_REAL, TEXT (a68_add_token (&A68 (top_token), "im")), NO_NODE);
+  (void) a68_add_mode_to_pack (&z, M_REF_REAL, TEXT (a68_add_token (&A68 (top_token), "re")), NO_NODE);
+  m = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z);
+  NAME (M_REF_COMPLEX) = m;
+  /* LONG COMPLEX.  */
+  z = NO_PACK;
+  (void) a68_add_mode_to_pack (&z, M_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "im")), NO_NODE);
+  (void) a68_add_mode_to_pack (&z, M_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "re")), NO_NODE);
+  m = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z);
+  EQUIVALENT (M_LONG_COMPLEX) = m;
+  z = NO_PACK;
+  (void) a68_add_mode_to_pack (&z, M_REF_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "im")), NO_NODE);
+  (void) a68_add_mode_to_pack (&z, M_REF_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "re")), NO_NODE);
+  m = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z);
+  NAME (M_REF_LONG_COMPLEX) = m;
+  /* LONG_LONG COMPLEX.  */
+  z = NO_PACK;
+  (void) a68_add_mode_to_pack (&z, M_LONG_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "im")), NO_NODE);
+  (void) a68_add_mode_to_pack (&z, M_LONG_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "re")), NO_NODE);
+  m = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z);
+  EQUIVALENT (M_LONG_LONG_COMPLEX) = m;
+  z = NO_PACK;
+  (void) a68_add_mode_to_pack (&z, M_REF_LONG_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "im")), NO_NODE);
+  (void) a68_add_mode_to_pack (&z, M_REF_LONG_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "re")), NO_NODE);
+  m = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z);
+  NAME (M_REF_LONG_LONG_COMPLEX) = m;
+  /* SEMA.  */
+  z = NO_PACK;
+  (void) a68_add_mode_to_pack (&z, M_REF_INT, NO_TEXT, NO_NODE);
+  EQUIVALENT (M_SEMA) = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z);
+  /* PROC VOID.  */
+  z = NO_PACK;
+  M_PROC_VOID = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (z), NO_NODE, M_VOID, z);
+  /* PROC (REAL) REAL.  */
+  z = NO_PACK;
+  (void) a68_add_mode_to_pack (&z, M_REAL, NO_TEXT, NO_NODE);
+  M_PROC_REAL_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (z), NO_NODE, M_REAL, z);
+  /* PROC (LONG_REAL) LONG_REAL.  */
+  z = NO_PACK;
+  (void) a68_add_mode_to_pack (&z, M_LONG_REAL, NO_TEXT, NO_NODE);
+  M_PROC_LONG_REAL_LONG_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (z), NO_NODE, M_LONG_REAL, z);
+  /* IO: PROC (REF FILE) BOOL.  */
+  z = NO_PACK;
+  (void) a68_add_mode_to_pack (&z, M_REF_FILE, NO_TEXT, NO_NODE);
+  M_PROC_REF_FILE_BOOL = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (z), NO_NODE, M_BOOL, z);
+  /* IO: PROC (REF FILE) VOID.  */
+  z = NO_PACK;
+  (void) a68_add_mode_to_pack (&z, M_REF_FILE, NO_TEXT, NO_NODE);
+  M_PROC_REF_FILE_VOID = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (z), NO_NODE, M_VOID, z);
+  /* IO: SIMPLIN and SIMPLOUT.  */
+  M_SIMPLIN = a68_add_mode (&TOP_MOID (&A68_JOB), IN_TYPE_MODE, 0, NO_NODE, NO_MOID, NO_PACK);
+  M_ROW_SIMPLIN = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_SIMPLIN, NO_PACK);
+  SLICE (M_ROW_SIMPLIN) = M_SIMPLIN;
+  M_SIMPLOUT = a68_add_mode (&TOP_MOID (&A68_JOB), OUT_TYPE_MODE, 0, NO_NODE, NO_MOID, NO_PACK);
+  M_ROW_SIMPLOUT = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_SIMPLOUT, NO_PACK);
+  SLICE (M_ROW_SIMPLOUT) = M_SIMPLOUT;
+}
+
+/* Set up standenv - general RR but not transput.  */
+
+static void
+stand_prelude (void)
+{
+  /* Identifiers.  */
+  a68_idf (A68_STD, "intlengths", M_INT, a68_lower_intlengths);
+  a68_idf (A68_STD, "intshorths", M_INT, a68_lower_intshorths);
+  a68_idf (A68_STD, "maxint", M_INT, a68_lower_maxint);
+  a68_idf (A68_STD, "longmaxint", M_LONG_INT, a68_lower_maxint);
+  a68_idf (A68_STD, "longlongmaxint", M_LONG_LONG_INT, a68_lower_maxint);
+  a68_idf (A68_STD, "shortmaxint", M_SHORT_INT, a68_lower_maxint);
+  a68_idf (A68_STD, "shortshortmaxint", M_SHORT_SHORT_INT, a68_lower_maxint);
+  a68_idf (A68_STD, "maxreal", M_REAL, a68_lower_maxreal);
+  a68_idf (A68_STD, "longmaxreal", M_LONG_REAL, a68_lower_maxreal);
+  a68_idf (A68_STD, "longlongmaxreal", M_LONG_LONG_REAL, a68_lower_maxreal);
+  a68_idf (A68_STD, "smallreal", M_REAL, a68_lower_smallreal);
+  a68_idf (A68_STD, "longsmallreal", M_LONG_REAL, a68_lower_smallreal);
+  a68_idf (A68_STD, "longlongsmallreal", M_LONG_LONG_REAL, a68_lower_smallreal);
+  a68_idf (A68_STD, "reallengths", M_INT, a68_lower_reallengths);
+  a68_idf (A68_STD, "realshorths", M_INT, a68_lower_realshorths);
+  a68_idf (A68_STD, "bitslengths", M_INT, a68_lower_bitslengths);
+  a68_idf (A68_STD, "bitsshorths", M_INT, a68_lower_bitsshorths);
+  a68_idf (A68_STD, "bitswidth", M_INT, a68_lower_bitswidth);
+  a68_idf (A68_STD, "longbitswidth", M_INT, a68_lower_longbitswidth);
+  a68_idf (A68_STD, "longlongbitswidth", M_INT, a68_lower_longlongbitswidth);
+  a68_idf (A68_STD, "shortbitswidth", M_INT, a68_lower_shortbitswidth);
+  a68_idf (A68_STD, "shortshortbitswidth", M_INT, a68_lower_shortshortbitswidth);
+  a68_idf (A68_STD, "maxbits", M_BITS, a68_lower_maxbits);
+  a68_idf (A68_STD, "longmaxbits", M_LONG_BITS, a68_lower_maxbits);
+  a68_idf (A68_STD, "longlongmaxbits", M_LONG_LONG_BITS, a68_lower_maxbits);
+  a68_idf (A68_STD, "maxabschar", M_INT, a68_lower_maxabschar);
+  a68_idf (A68_STD, "intwidth", M_INT, a68_lower_intwidth);
+  a68_idf (A68_STD, "longintwidth", M_INT, a68_lower_longintwidth);
+  a68_idf (A68_STD, "longlongintwidth", M_INT, a68_lower_longlongintwidth);
+  a68_idf (A68_STD, "shortintwidth", M_INT, a68_lower_shortintwidth);
+  a68_idf (A68_STD, "shortshortintwidth", M_INT, a68_lower_shortshortintwidth);
+  a68_idf (A68_STD, "realwidth", M_INT, a68_lower_realwidth);
+  a68_idf (A68_STD, "longrealwidth", M_INT, a68_lower_longrealwidth);
+  a68_idf (A68_STD, "longlongrealwidth", M_INT, a68_lower_longlongrealwidth);
+  a68_idf (A68_STD, "expwidth", M_INT, a68_lower_expwidth);
+  a68_idf (A68_STD, "longexpwidth", M_INT, a68_lower_longexpwidth);
+  a68_idf (A68_STD, "longlongexpwidth", M_INT, a68_lower_longlongexpwidth);
+  a68_idf (A68_STD, "pi", M_REAL, a68_lower_pi);
+  a68_idf (A68_STD, "longpi", M_LONG_REAL, a68_lower_pi);
+  a68_idf (A68_STD, "longlongpi", M_LONG_LONG_REAL, a68_lower_pi);
+  a68_idf (A68_STD, "compllengths", M_INT);
+  a68_idf (A68_STD, "complshorths", M_INT);
+  a68_idf (A68_STD, "byteslengths", M_INT);
+  a68_idf (A68_STD, "bytesshorths", M_INT);
+  a68_idf (A68_STD, "byteswidth", M_INT);
+  a68_idf (A68_STD, "longbyteswidth", M_INT);
+  a68_idf (A68_STD, "flip", M_CHAR, a68_lower_flip);
+  a68_idf (A68_STD, "flop", M_CHAR, a68_lower_flop);
+  a68_idf (A68_STD, "errorchar", M_CHAR, a68_lower_errorchar);
+  a68_idf (A68_STD, "nullcharacter", M_CHAR, a68_lower_nullcharacter);
+  a68_idf (A68_STD, "blank", M_CHAR, a68_lower_blank);
+  /* BITS procedures.  */
+  MOID_T *m = a68_proc (M_BITS, M_ROW_BOOL, NO_MOID);
+  a68_idf (A68_STD, "bitspack", m);
+  /* SHORT BITS procedures.  */
+  m = a68_proc (M_SHORT_BITS, M_ROW_BOOL, NO_MOID);
+  a68_idf (A68_STD, "shortbitspack", m);
+  /* SHORT SHORT BITS procedures.  */
+  m = a68_proc (M_SHORT_SHORT_BITS, M_ROW_BOOL, NO_MOID);
+  a68_idf (A68_STD, "shortshortbitspack", m);
+  /* LONG BITS procedures.  */
+  m = a68_proc (M_LONG_BITS, M_ROW_BOOL, NO_MOID);
+  a68_idf (A68_STD, "longbitspack", m);
+  /* LONG LONG BITS procedures.  */
+  m = a68_proc (M_LONG_LONG_BITS, M_ROW_BOOL, NO_MOID);
+  a68_idf (A68_STD, "longlongbitspack", m);
+  /* RNG procedures.  */
+  m = a68_proc (M_VOID, M_INT, NO_MOID);
+  a68_idf (A68_STD, "firstrandom", m);
+  /* REAL procedures.  */
+  m = A68_MCACHE (proc_real);
+  a68_idf (A68_STD, "nextrandom", m);
+  a68_idf (A68_STD, "random", m, a68_lower_random);
+  a68_idf (A68_STD, "rnd", m);
+  m = A68_MCACHE (proc_real_real);
+  a68_idf (A68_STD, "arccos", m, a68_lower_acos);
+  a68_idf (A68_STD, "arcsin", m, a68_lower_asin);
+  a68_idf (A68_STD, "arctan", m, a68_lower_atan);
+  a68_idf (A68_STD, "cos", m, a68_lower_cos);
+  a68_idf (A68_STD, "exp", m, a68_lower_exp);
+  a68_idf (A68_STD, "ln", m, a68_lower_ln);
+  a68_idf (A68_STD, "sin", m, a68_lower_sin);
+  a68_idf (A68_STD, "sqrt", m, a68_lower_sqrt);
+  a68_idf (A68_STD, "tan", m, a68_lower_tan);
+  /* LONG REAL procedures.  */
+  m = a68_proc (M_LONG_REAL, NO_MOID);
+  a68_idf (A68_STD, "longnextrandom", m);
+  a68_idf (A68_STD, "longrandom", m, a68_lower_longrandom);
+  m = a68_proc (M_LONG_REAL, M_LONG_REAL, NO_MOID);
+  a68_idf (A68_STD, "longarccos", m, a68_lower_long_acos);
+  a68_idf (A68_STD, "longarcsin", m, a68_lower_long_asin);
+  a68_idf (A68_STD, "longarctan", m, a68_lower_long_atan);
+  a68_idf (A68_STD, "longcos", m, a68_lower_long_cos);
+  a68_idf (A68_STD, "longexp", m, a68_lower_long_exp);
+  a68_idf (A68_STD, "longln", m, a68_lower_long_ln);
+  a68_idf (A68_STD, "longsin", m, a68_lower_long_sin);
+  a68_idf (A68_STD, "longsqrt", m, a68_lower_long_sqrt);
+  a68_idf (A68_STD, "longtan", m, a68_lower_long_tan);
+  /* LONG LONG REAL procedures.  */
+  m = a68_proc (M_LONG_LONG_REAL, NO_MOID);
+  a68_idf (A68_STD, "longlongnextrandom", m);
+  a68_idf (A68_STD, "longlongrandom", m, a68_lower_longlongrandom);
+  m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID);
+  a68_idf (A68_STD, "longlongarccos", m, a68_lower_long_long_acos);
+  a68_idf (A68_STD, "longlongarcsin", m, a68_lower_long_long_asin);
+  a68_idf (A68_STD, "longlongarctan", m, a68_lower_long_long_atan);
+  a68_idf (A68_STD, "longlongcos", m, a68_lower_long_long_cos);
+  a68_idf (A68_STD, "longlongexp", m, a68_lower_long_long_exp);
+  a68_idf (A68_STD, "longlongln", m, a68_lower_long_long_ln);
+  a68_idf (A68_STD, "longlongsin", m, a68_lower_long_long_sin);
+  a68_idf (A68_STD, "longlongsqrt", m, a68_lower_long_long_sqrt);
+  a68_idf (A68_STD, "longlongtan", m, a68_lower_long_long_tan);
+  /* Priorities.  */
+  a68_prio ("+:=", 1);
+  a68_prio ("-:=", 1);
+  a68_prio ("*:=", 1);
+  a68_prio ("/:=", 1);
+  a68_prio ("%:=", 1);
+  a68_prio ("%*:=", 1);
+  a68_prio ("+=:", 1);
+  a68_prio ("PLUSAB", 1);
+  a68_prio ("MINUSAB", 1);
+  a68_prio ("TIMESAB", 1);
+  a68_prio ("DIVAB", 1);
+  a68_prio ("OVERAB", 1);
+  a68_prio ("MODAB", 1);
+  a68_prio ("PLUSTO", 1);
+  a68_prio ("OR", 2);
+  a68_prio ("AND", 3);
+  a68_prio ("XOR", 3);
+  a68_prio ("=", 4);
+  a68_prio ("/=", 4);
+  a68_prio ("<", 5);
+  a68_prio ("<=", 5);
+  a68_prio (">", 5);
+  a68_prio (">=", 5);
+  a68_prio ("EQ", 4);
+  a68_prio ("NE", 4);
+  a68_prio ("LT", 5);
+  a68_prio ("LE", 5);
+  a68_prio ("GT", 5);
+  a68_prio ("GE", 5);
+  a68_prio ("+", 6);
+  a68_prio ("-", 6);
+  a68_prio ("*", 7);
+  a68_prio ("/", 7);
+  a68_prio ("OVER", 7);
+  a68_prio ("%", 7);
+  a68_prio ("MOD", 7);
+  a68_prio ("%*", 7);
+  a68_prio ("ELEM", 7);
+  a68_prio ("**", 8);
+  a68_prio ("SHL", 8);
+  a68_prio ("SHR", 8);
+  a68_prio ("UP", 8);
+  a68_prio ("DOWN", 8);
+  a68_prio ("^", 8);
+  a68_prio ("LWB", 8);
+  a68_prio ("UPB", 8);
+  a68_prio ("I", 9);
+  a68_prio ("+*", 9);
+  /* BOOL operators.  */
+  m = a68_proc (M_BOOL, M_BOOL, NO_MOID);
+  a68_op (A68_STD, "NOT", m, a68_lower_not2);
+  a68_op (A68_STD, "~", m, a68_lower_not2);
+  m = a68_proc (M_INT, M_BOOL, NO_MOID);
+  a68_op (A68_STD, "ABS", m, a68_lower_boolabs2);
+  m = a68_proc (M_BOOL, M_BOOL, M_BOOL, NO_MOID);
+  a68_op (A68_STD, "OR", m, a68_lower_or3);
+  a68_op (A68_STD, "AND", m, a68_lower_and3);
+  a68_op (A68_STD, "=", m, a68_lower_bool_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_bool_ne3);
+  a68_op (A68_STD, "EQ", m, a68_lower_bool_eq3);
+  a68_op (A68_STD, "NE", m, a68_lower_bool_ne3);
+  /* CHAR operators.  */
+  m = a68_proc (M_BOOL, M_CHAR, M_CHAR, NO_MOID);
+  a68_op (A68_STD, "=", m, a68_lower_char_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_char_ne3);
+  a68_op (A68_STD, "<", m, a68_lower_char_lt3);
+  a68_op (A68_STD, "<=", m, a68_lower_char_le3);
+  a68_op (A68_STD, ">", m, a68_lower_char_gt3);
+  a68_op (A68_STD, ">=", m, a68_lower_char_ge3);
+  a68_op (A68_STD, "EQ", m, a68_lower_char_eq3);
+  a68_op (A68_STD, "NE", m, a68_lower_char_ne3);
+  a68_op (A68_STD, "LT", m, a68_lower_char_lt3);
+  a68_op (A68_STD, "LE", m, a68_lower_char_le3);
+  a68_op (A68_STD, "GT", m, a68_lower_char_gt3);
+  a68_op (A68_STD, "GE", m, a68_lower_char_ge3);
+  m = a68_proc (M_INT, M_CHAR, NO_MOID);
+  a68_op (A68_STD, "ABS", m, a68_lower_charabs2);
+  m = a68_proc (M_CHAR, M_INT, NO_MOID);
+  a68_op (A68_STD, "REPR", m, a68_lower_repr2);
+  /* STRING operators.  */
+  m = a68_proc (M_BOOL, M_STRING, M_STRING, NO_MOID);
+  a68_op (A68_STD, "=", m, a68_lower_string_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_string_ne3);
+  a68_op (A68_STD, "<", m, a68_lower_string_lt3);
+  a68_op (A68_STD, "<=", m, a68_lower_string_le3);
+  a68_op (A68_STD, ">=", m, a68_lower_string_ge3);
+  a68_op (A68_STD, ">", m, a68_lower_string_gt3);
+  a68_op (A68_STD, "EQ", m, a68_lower_string_eq3);
+  a68_op (A68_STD, "NE", m, a68_lower_string_ne3);
+  a68_op (A68_STD, "LT", m, a68_lower_string_lt3);
+  a68_op (A68_STD, "LE", m, a68_lower_string_le3);
+  a68_op (A68_STD, "GE", m, a68_lower_string_ge3);
+  a68_op (A68_STD, "GT", m, a68_lower_string_gt3);
+  m = a68_proc (M_STRING, M_CHAR, M_CHAR, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_char_plus3);
+  m = a68_proc (M_STRING, M_STRING, M_STRING, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_string_plus3);
+  m = a68_proc (M_REF_STRING, M_REF_STRING, M_STRING, NO_MOID);
+  a68_op (A68_STD, "+:=", m, a68_lower_string_plusab3);
+  a68_op (A68_STD, "PLUSAB", m, a68_lower_string_plusab3);
+  m = a68_proc (M_REF_STRING, M_REF_STRING, M_INT, NO_MOID);
+  a68_op (A68_STD, "*:=", m, a68_lower_string_multab3);
+  a68_op (A68_STD, "TIMESAB", m, a68_lower_string_multab3);
+  m = a68_proc (M_REF_STRING, M_STRING, M_REF_STRING, NO_MOID);
+  a68_op (A68_STD, "+=:", m, a68_lower_string_plusto3);
+  a68_op (A68_STD, "PLUSTO", m, a68_lower_string_plusto3);
+  m = a68_proc (M_STRING, M_STRING, M_INT, NO_MOID);
+  a68_op (A68_STD, "*", m, a68_lower_string_mult3);
+  m = a68_proc (M_STRING, M_INT, M_STRING, NO_MOID);
+  a68_op (A68_STD, "*", m, a68_lower_string_mult3);
+  m = a68_proc (M_STRING, M_INT, M_CHAR, NO_MOID);
+  a68_op (A68_STD, "*", m, a68_lower_char_mult3);
+  m = a68_proc (M_STRING, M_CHAR, M_INT, NO_MOID);
+  a68_op (A68_STD, "*", m, a68_lower_char_mult3);
+  /* SHORT SHORT INT operators.  */
+  m = a68_proc (M_SHORT_SHORT_INT, M_SHORT_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_confirm2);
+  a68_op (A68_STD, "-", m, a68_lower_negate2);
+  a68_op (A68_STD, "ABS", m, a68_lower_intabs2);
+  m = a68_proc (M_INT, M_SHORT_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "SIGN", m, a68_lower_sign2);
+  m = a68_proc (M_SHORT_INT, M_SHORT_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "LENG", m, a68_lower_lengint2);
+  m = a68_proc (M_BOOL, M_SHORT_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "ODD", m, a68_lower_odd2);
+  m = a68_proc (M_SHORT_SHORT_INT, M_SHORT_SHORT_INT, M_SHORT_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_plus_int);
+  a68_op (A68_STD, "-", m, a68_lower_minus_int);
+  a68_op (A68_STD, "*", m, a68_lower_mult_int);
+  a68_op (A68_STD, "OVER", m, a68_lower_over3);
+  a68_op (A68_STD, "%", m, a68_lower_over3);
+  a68_op (A68_STD, "MOD", m, a68_lower_mod3);
+  a68_op (A68_STD, "%*", m, a68_lower_mod3);
+  m = a68_proc (M_REF_SHORT_SHORT_INT, M_REF_SHORT_SHORT_INT, M_SHORT_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "+:=", m, a68_lower_plusab3);
+  a68_op (A68_STD, "-:=", m, a68_lower_minusab3);
+  a68_op (A68_STD, "*:=", m, a68_lower_multab3);
+  a68_op (A68_STD, "%:=", m, a68_lower_overab3);
+  a68_op (A68_STD, "%*:=", m, a68_lower_modab3);
+  a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3);
+  a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3);
+  a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3);
+  a68_op (A68_STD, "OVERAB", m, a68_lower_overab3);
+  a68_op (A68_STD, "MODAB", m, a68_lower_modab3);
+  m = a68_proc (M_BOOL, M_SHORT_SHORT_INT, M_SHORT_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "EQ", m, a68_lower_int_eq3);
+  a68_op (A68_STD, "NE", m, a68_lower_int_ne3);
+  a68_op (A68_STD, "GE", m, a68_lower_int_ge3);
+  a68_op (A68_STD, "GT", m, a68_lower_int_gt3);
+  a68_op (A68_STD, "LE", m, a68_lower_int_le3);
+  a68_op (A68_STD, "LT", m, a68_lower_int_lt3);
+  a68_op (A68_STD, "=", m, a68_lower_int_eq3);
+  a68_op (A68_STD, ">=", m, a68_lower_int_ge3);
+  a68_op (A68_STD, ">", m, a68_lower_int_gt3);
+  a68_op (A68_STD, "<=", m, a68_lower_int_le3);
+  a68_op (A68_STD, "<", m, a68_lower_int_lt3);
+  a68_op (A68_STD, "/=", m, a68_lower_int_ne3);
+  m = a68_proc (M_SHORT_SHORT_INT, M_SHORT_SHORT_INT, M_INT, NO_MOID);
+  a68_op (A68_STD, "**", m, a68_lower_pow_int);
+  a68_op (A68_STD, "^", m, a68_lower_pow_int);
+  /* SHORT INT operators.  */
+  m = a68_proc (M_SHORT_INT, M_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_confirm2);
+  a68_op (A68_STD, "-", m, a68_lower_negate2);
+  a68_op (A68_STD, "ABS", m, a68_lower_intabs2);
+  m = a68_proc (M_SHORT_SHORT_INT, M_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "SHORTEN", m, a68_lower_shortenint2);
+  m = a68_proc (M_INT, M_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "LENG", m, a68_lower_lengint2);
+  a68_op (A68_STD, "SIGN", m, a68_lower_sign2);
+  m = a68_proc (M_BOOL, M_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "ODD", m, a68_lower_odd2);
+  m = a68_proc (M_SHORT_INT, M_SHORT_INT, M_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_plus_int);
+  a68_op (A68_STD, "-", m, a68_lower_minus_int);
+  a68_op (A68_STD, "*", m, a68_lower_mult_int);
+  a68_op (A68_STD, "OVER", m, a68_lower_over3);
+  a68_op (A68_STD, "%", m, a68_lower_over3);
+  a68_op (A68_STD, "MOD", m, a68_lower_mod3);
+  a68_op (A68_STD, "%*", m, a68_lower_mod3);
+  m = a68_proc (M_REF_SHORT_INT, M_REF_SHORT_INT, M_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "+:=", m, a68_lower_plusab3);
+  a68_op (A68_STD, "-:=", m, a68_lower_minusab3);
+  a68_op (A68_STD, "*:=", m, a68_lower_multab3);
+  a68_op (A68_STD, "%:=", m, a68_lower_overab3);
+  a68_op (A68_STD, "%*:=", m, a68_lower_modab3);
+  a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3);
+  a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3);
+  a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3);
+  a68_op (A68_STD, "OVERAB", m, a68_lower_overab3);
+  a68_op (A68_STD, "MODAB", m, a68_lower_modab3);
+  m = a68_proc (M_BOOL, M_SHORT_INT, M_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "=", m, a68_lower_int_eq3);
+  a68_op (A68_STD, "EQ", m, a68_lower_int_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_int_ne3);
+  a68_op (A68_STD, "NE", m, a68_lower_int_ne3);
+  a68_op (A68_STD, "<", m, a68_lower_int_lt3);
+  a68_op (A68_STD, "LT", m, a68_lower_int_lt3);
+  a68_op (A68_STD, "<=", m, a68_lower_int_le3);
+  a68_op (A68_STD, "LE", m, a68_lower_int_le3);
+  a68_op (A68_STD, ">", m, a68_lower_int_gt3);
+  a68_op (A68_STD, "GT", m, a68_lower_int_gt3);
+  a68_op (A68_STD, ">=", m, a68_lower_int_ge3);
+  a68_op (A68_STD, "GE", m, a68_lower_int_ge3);
+  m = a68_proc (M_SHORT_INT, M_SHORT_INT, M_INT, NO_MOID);
+  a68_op (A68_STD, "**", m, a68_lower_pow_int);
+  a68_op (A68_STD, "^", m, a68_lower_pow_int);
+  /* INT operators. */
+  m = a68_proc (M_INT, M_INT, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_confirm2);
+  a68_op (A68_STD, "-", m, a68_lower_negate2);
+  a68_op (A68_STD, "ABS", m, a68_lower_intabs2);
+  a68_op (A68_STD, "SIGN", m, a68_lower_sign2);
+  m = a68_proc (M_SHORT_INT, M_INT, NO_MOID);
+  a68_op (A68_STD, "SHORTEN", m, a68_lower_shortenint2);
+  m = a68_proc (M_LONG_INT, M_INT, NO_MOID);
+  a68_op (A68_STD, "LENG", m, a68_lower_lengint2);
+  m = a68_proc (M_BOOL, M_INT, NO_MOID);
+  a68_op (A68_STD, "ODD", m, a68_lower_odd2);
+  m = a68_proc (M_BOOL, M_INT, M_INT, NO_MOID);
+  a68_op (A68_STD, "=", m, a68_lower_int_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_int_ne3);
+  a68_op (A68_STD, "<", m, a68_lower_int_lt3);
+  a68_op (A68_STD, "<=", m, a68_lower_int_le3);
+  a68_op (A68_STD, ">", m, a68_lower_int_gt3);
+  a68_op (A68_STD, ">=", m, a68_lower_int_ge3);
+  a68_op (A68_STD, "EQ", m, a68_lower_int_eq3);
+  a68_op (A68_STD, "NE", m, a68_lower_int_ne3);
+  a68_op (A68_STD, "LT", m, a68_lower_int_lt3);
+  a68_op (A68_STD, "LE", m, a68_lower_int_le3);
+  a68_op (A68_STD, "GT", m, a68_lower_int_gt3);
+  a68_op (A68_STD, "GE", m, a68_lower_int_ge3);
+  m = a68_proc (M_INT, M_INT, M_INT, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_plus_int);
+  a68_op (A68_STD, "-", m, a68_lower_minus_int);
+  a68_op (A68_STD, "*", m, a68_lower_mult_int);
+  a68_op (A68_STD, "OVER", m, a68_lower_over3);
+  a68_op (A68_STD, "%", m, a68_lower_over3);
+  a68_op (A68_STD, "MOD", m, a68_lower_mod3);
+  a68_op (A68_STD, "%*", m, a68_lower_mod3);
+  a68_op (A68_STD, "**", m, a68_lower_pow_int);
+  a68_op (A68_STD, "^", m, a68_lower_pow_int);
+  m = a68_proc (M_REAL, M_INT, M_INT, NO_MOID);
+  a68_op (A68_STD, "/", m, a68_lower_rdiv3);
+  m = a68_proc (M_REF_INT, M_REF_INT, M_INT, NO_MOID);
+  a68_op (A68_STD, "+:=", m, a68_lower_plusab3);
+  a68_op (A68_STD, "-:=", m, a68_lower_minusab3);
+  a68_op (A68_STD, "*:=", m, a68_lower_multab3);
+  a68_op (A68_STD, "%:=", m, a68_lower_overab3);
+  a68_op (A68_STD, "%*:=", m, a68_lower_modab3);
+  a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3);
+  a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3);
+  a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3);
+  a68_op (A68_STD, "OVERAB", m, a68_lower_overab3);
+  a68_op (A68_STD, "MODAB", m, a68_lower_modab3);
+  /* LONG INT operators */
+  m = a68_proc (M_LONG_INT, M_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_confirm2);
+  a68_op (A68_STD, "-", m, a68_lower_negate2);
+  a68_op (A68_STD, "ABS", m, a68_lower_intabs2);
+  m = a68_proc (M_INT, M_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "SHORTEN", m, a68_lower_shortenint2);
+  a68_op (A68_STD, "SIGN", m, a68_lower_sign2);
+  m = a68_proc (M_LONG_LONG_INT, M_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "LENG", m, a68_lower_lengint2);
+  m = a68_proc (M_BOOL, M_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "ODD", m, a68_lower_odd2);
+  m = a68_proc (M_LONG_INT, M_LONG_INT, M_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_plus_int);
+  a68_op (A68_STD, "-", m, a68_lower_minus_int);
+  a68_op (A68_STD, "*", m, a68_lower_mult_int);
+  a68_op (A68_STD, "OVER", m, a68_lower_over3);
+  a68_op (A68_STD, "%", m, a68_lower_over3);
+  a68_op (A68_STD, "MOD", m, a68_lower_mod3);
+  a68_op (A68_STD, "%*", m, a68_lower_mod3);
+  m = a68_proc (M_REF_LONG_INT, M_REF_LONG_INT, M_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "+:=", m, a68_lower_plusab3);
+  a68_op (A68_STD, "-:=", m, a68_lower_minusab3);
+  a68_op (A68_STD, "*:=", m, a68_lower_multab3);
+  a68_op (A68_STD, "%:=", m, a68_lower_overab3);
+  a68_op (A68_STD, "%*:=", m, a68_lower_modab3);
+  a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3);
+  a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3);
+  a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3);
+  a68_op (A68_STD, "OVERAB", m, a68_lower_overab3);
+  a68_op (A68_STD, "MODAB", m, a68_lower_modab3);
+  m = a68_proc (M_BOOL, M_LONG_INT, M_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "=", m, a68_lower_int_eq3);
+  a68_op (A68_STD, "EQ", m, a68_lower_int_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_int_ne3);
+  a68_op (A68_STD, "NE", m, a68_lower_int_ne3);
+  a68_op (A68_STD, "<", m, a68_lower_int_lt3);
+  a68_op (A68_STD, "LT", m, a68_lower_int_lt3);
+  a68_op (A68_STD, "<=", m, a68_lower_int_le3);
+  a68_op (A68_STD, "LE", m, a68_lower_int_le3);
+  a68_op (A68_STD, ">", m, a68_lower_int_gt3);
+  a68_op (A68_STD, "GT", m, a68_lower_int_gt3);
+  a68_op (A68_STD, ">=", m, a68_lower_int_ge3);
+  a68_op (A68_STD, "GE", m, a68_lower_int_ge3);
+  m = a68_proc (M_LONG_REAL, M_LONG_INT, M_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "/", m, a68_lower_rdiv3);
+  m = a68_proc (M_LONG_INT, M_LONG_INT, M_INT, NO_MOID);
+  a68_op (A68_STD, "**", m, a68_lower_pow_int);
+  a68_op (A68_STD, "^", m, a68_lower_pow_int);
+  /* LONG LONG INT operators. */
+  m = a68_proc (M_LONG_LONG_INT, M_LONG_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_confirm2);
+  a68_op (A68_STD, "-", m, a68_lower_negate2);
+  a68_op (A68_STD, "ABS", m, a68_lower_intabs2);
+  m = a68_proc (M_INT, M_LONG_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "SIGN", m, a68_lower_sign2);
+  m = a68_proc (M_LONG_INT, M_LONG_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "SHORTEN", m, a68_lower_shortenint2);
+  m = a68_proc (M_BOOL, M_LONG_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "ODD", m, a68_lower_odd2);
+  m = a68_proc (M_LONG_LONG_INT, M_LONG_LONG_INT, M_LONG_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_plus_int);
+  a68_op (A68_STD, "-", m, a68_lower_minus_int);
+  a68_op (A68_STD, "*", m, a68_lower_mult_int);
+  a68_op (A68_STD, "OVER", m, a68_lower_over3);
+  a68_op (A68_STD, "%", m, a68_lower_over3);
+  a68_op (A68_STD, "MOD", m, a68_lower_mod3);
+  a68_op (A68_STD, "%*", m, a68_lower_mod3);
+  m = a68_proc (M_REF_LONG_LONG_INT, M_REF_LONG_LONG_INT, M_LONG_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "+:=", m, a68_lower_plusab3);
+  a68_op (A68_STD, "-:=", m, a68_lower_minusab3);
+  a68_op (A68_STD, "*:=", m, a68_lower_multab3);
+  a68_op (A68_STD, "%:=", m, a68_lower_overab3);
+  a68_op (A68_STD, "%*:=", m, a68_lower_modab3);
+  a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3);
+  a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3);
+  a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3);
+  a68_op (A68_STD, "OVERAB", m, a68_lower_overab3);
+  a68_op (A68_STD, "MODAB", m, a68_lower_modab3);
+  m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_INT, M_LONG_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "/", m, a68_lower_rdiv3);
+  m = a68_proc (M_BOOL, M_LONG_LONG_INT, M_LONG_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "EQ", m, a68_lower_int_eq3);
+  a68_op (A68_STD, "NE", m, a68_lower_int_ne3);
+  a68_op (A68_STD, "GE", m, a68_lower_int_ge3);
+  a68_op (A68_STD, "GT", m, a68_lower_int_gt3);
+  a68_op (A68_STD, "LE", m, a68_lower_int_le3);
+  a68_op (A68_STD, "LT", m, a68_lower_int_lt3);
+  a68_op (A68_STD, "=", m, a68_lower_int_eq3);
+  a68_op (A68_STD, ">=", m, a68_lower_int_ge3);
+  a68_op (A68_STD, ">", m, a68_lower_int_gt3);
+  a68_op (A68_STD, "<=", m, a68_lower_int_le3);
+  a68_op (A68_STD, "<", m, a68_lower_int_lt3);
+  a68_op (A68_STD, "/=", m, a68_lower_int_ne3);
+  m = a68_proc (M_LONG_LONG_INT, M_LONG_LONG_INT, M_INT, NO_MOID);
+  a68_op (A68_STD, "**", m, a68_lower_pow_int);
+  a68_op (A68_STD, "^", m, a68_lower_pow_int);
+  /* SHORT SHORT BITS operators  */
+  m = a68_proc (M_BOOL, M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, NO_MOID);
+  a68_op (A68_STD, "=", m, a68_lower_bit_eq3);
+  a68_op (A68_STD, "EQ", m, a68_lower_bit_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_bit_ne3);
+  a68_op (A68_STD, "NE", m, a68_lower_bit_ne3);
+  a68_op (A68_STD, "<=", m, a68_lower_bit_le3);
+  a68_op (A68_STD, "LE", m, a68_lower_bit_le3);
+  a68_op (A68_STD, ">=", m, a68_lower_bit_ge3);
+  a68_op (A68_STD, "GE", m, a68_lower_bit_ge3);
+  m = a68_proc (M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, NO_MOID);
+  a68_op (A68_STD, "NOT", m, a68_lower_bitnot2);
+  a68_op (A68_STD, "~", m, a68_lower_bitnot2);
+  m = a68_proc (M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, NO_MOID);
+  a68_op (A68_STD, "AND", m, a68_lower_bitand3);
+  a68_op (A68_STD, "OR", m, a68_lower_bitior3);
+  m = a68_proc (M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, M_INT, NO_MOID);
+  a68_op (A68_STD, "SHL", m, a68_lower_shl3);
+  a68_op (A68_STD, "UP", m, a68_lower_shl3);
+  a68_op (A68_STD, "SHR", m, a68_lower_shr3);
+  a68_op (A68_STD, "DOWN", m, a68_lower_shr3);
+  m = a68_proc (M_BOOL, M_INT, M_SHORT_SHORT_BITS, NO_MOID);
+  a68_op (A68_STD, "ELEM", m, a68_lower_bitelem3);
+  m = a68_proc (M_SHORT_SHORT_BITS, M_SHORT_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "BIN", m, a68_lower_bin2);
+  m = a68_proc (M_SHORT_SHORT_INT, M_SHORT_SHORT_BITS, NO_MOID);
+  a68_op (A68_STD, "ABS", m, a68_lower_bitabs2);
+  m = a68_proc (M_SHORT_BITS, M_SHORT_SHORT_BITS, NO_MOID);
+  a68_op (A68_STD, "LENG", m, a68_lower_bitleng2);
+  /* SHORT BITS operatos.  */
+  m = a68_proc (M_SHORT_INT, M_SHORT_BITS, NO_MOID);
+  a68_op (A68_STD, "ABS", m, a68_lower_bitabs2);
+  m = a68_proc (M_SHORT_BITS, M_SHORT_INT, NO_MOID);
+  a68_op (A68_STD, "BIN", m, a68_lower_bin2);
+  m = a68_proc (M_SHORT_BITS, M_SHORT_BITS, NO_MOID);
+  a68_op (A68_STD, "NOT", m, a68_lower_bitnot2);
+  a68_op (A68_STD, "~", m, a68_lower_bitnot2);
+  m = a68_proc (M_BOOL, M_SHORT_BITS, M_SHORT_BITS, NO_MOID);
+  a68_op (A68_STD, "=", m, a68_lower_bit_eq3);
+  a68_op (A68_STD, "EQ", m, a68_lower_bit_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_bit_ne3);
+  a68_op (A68_STD, "NE", m, a68_lower_bit_ne3);
+  a68_op (A68_STD, "<=", m, a68_lower_bit_le3);
+  a68_op (A68_STD, "LE", m, a68_lower_bit_le3);
+  a68_op (A68_STD, ">=", m, a68_lower_bit_ge3);
+  a68_op (A68_STD, "GE", m, a68_lower_bit_ge3);
+  m = a68_proc (M_SHORT_BITS, M_SHORT_BITS, M_SHORT_BITS, NO_MOID);
+  a68_op (A68_STD, "AND", m, a68_lower_bitand3);
+  a68_op (A68_STD, "OR", m, a68_lower_bitior3);
+  m = a68_proc (M_SHORT_BITS, M_SHORT_BITS, M_INT, NO_MOID);
+  a68_op (A68_STD, "SHL", m, a68_lower_shl3);
+  a68_op (A68_STD, "UP", m, a68_lower_shl3);
+  a68_op (A68_STD, "SHR", m, a68_lower_shr3);
+  a68_op (A68_STD, "DOWN", m, a68_lower_shr3);
+  m = a68_proc (M_BOOL, M_INT, M_SHORT_BITS, NO_MOID);
+  a68_op (A68_STD, "ELEM", m, a68_lower_bitelem3);
+  m = a68_proc (M_SHORT_SHORT_BITS, M_SHORT_BITS, NO_MOID);
+  a68_op (A68_STD, "SHORTEN", m, a68_lower_bitshorten2);
+  m = a68_proc (M_BITS, M_SHORT_BITS, NO_MOID);
+  a68_op (A68_STD, "LENG", m,  a68_lower_bitleng2);
+  /* BITS operators.  */
+  m = a68_proc (M_INT, M_BITS, NO_MOID);
+  a68_op (A68_STD, "ABS", m, a68_lower_bitabs2);
+  m = a68_proc (M_BITS, M_INT, NO_MOID);
+  a68_op (A68_STD, "BIN", m, a68_lower_bin2);
+  m = a68_proc (M_BITS, M_BITS, NO_MOID);
+  a68_op (A68_STD, "NOT", m, a68_lower_bitnot2);
+  a68_op (A68_STD, "~", m, a68_lower_bitnot2);
+  m = a68_proc (M_BOOL, M_BITS, M_BITS, NO_MOID);
+  a68_op (A68_STD, "=", m, a68_lower_bit_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_bit_ne3);
+  a68_op (A68_STD, "<=", m, a68_lower_bit_le3);
+  a68_op (A68_STD, ">=", m, a68_lower_bit_ge3);
+  a68_op (A68_STD, "EQ", m, a68_lower_bit_eq3);
+  a68_op (A68_STD, "NE", m, a68_lower_bit_ne3);
+  a68_op (A68_STD, "LE", m, a68_lower_bit_le3);
+  a68_op (A68_STD, "GE", m, a68_lower_bit_ge3);
+  m = a68_proc (M_BITS, M_BITS, M_BITS, NO_MOID);
+  a68_op (A68_STD, "AND", m, a68_lower_bitand3);
+  a68_op (A68_STD, "OR", m, a68_lower_bitior3);
+  m = a68_proc (M_BITS, M_BITS, M_INT, NO_MOID);
+  a68_op (A68_STD, "SHL", m, a68_lower_shl3);
+  a68_op (A68_STD, "UP", m, a68_lower_shl3);
+  a68_op (A68_STD, "SHR", m, a68_lower_shr3);
+  a68_op (A68_STD, "DOWN", m, a68_lower_shr3);
+  m = a68_proc (M_BOOL, M_INT, M_BITS, NO_MOID);
+  a68_op (A68_STD, "ELEM", m, a68_lower_bitelem3);
+  m = a68_proc (M_LONG_BITS, M_BITS, NO_MOID);
+  a68_op (A68_STD, "LENG", m, a68_lower_bitleng2);
+  m = a68_proc (M_SHORT_BITS, M_BITS, NO_MOID);
+  a68_op (A68_STD, "SHORTEN", m, a68_lower_bitshorten2);
+  /* LONG BITS operatos.  */
+  m = a68_proc (M_LONG_INT, M_LONG_BITS, NO_MOID);
+  a68_op (A68_STD, "ABS", m, a68_lower_bitabs2);
+  m = a68_proc (M_LONG_BITS, M_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "BIN", m, a68_lower_bin2);
+  m = a68_proc (M_LONG_BITS, M_LONG_BITS, NO_MOID);
+  a68_op (A68_STD, "NOT", m, a68_lower_bitnot2);
+  a68_op (A68_STD, "~", m, a68_lower_bitnot2);
+  m = a68_proc (M_BOOL, M_LONG_BITS, M_LONG_BITS, NO_MOID);
+  a68_op (A68_STD, "=", m, a68_lower_bit_eq3);
+  a68_op (A68_STD, "EQ", m, a68_lower_bit_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_bit_ne3);
+  a68_op (A68_STD, "NE", m, a68_lower_bit_ne3);
+  a68_op (A68_STD, "<=", m, a68_lower_bit_le3);
+  a68_op (A68_STD, "LE", m, a68_lower_bit_le3);
+  a68_op (A68_STD, ">=", m, a68_lower_bit_ge3);
+  a68_op (A68_STD, "GE", m, a68_lower_bit_ge3);
+  m = a68_proc (M_LONG_BITS, M_LONG_BITS, M_LONG_BITS, NO_MOID);
+  a68_op (A68_STD, "AND", m, a68_lower_bitand3);
+  a68_op (A68_STD, "OR", m, a68_lower_bitior3);
+  m = a68_proc (M_LONG_BITS, M_LONG_BITS, M_INT, NO_MOID);
+  a68_op (A68_STD, "SHL", m, a68_lower_shl3);
+  a68_op (A68_STD, "UP", m, a68_lower_shl3);
+  a68_op (A68_STD, "SHR", m, a68_lower_shr3);
+  a68_op (A68_STD, "DOWN", m, a68_lower_shr3);
+  m = a68_proc (M_BOOL, M_INT, M_LONG_BITS, NO_MOID);
+  a68_op (A68_STD, "ELEM", m, a68_lower_bitelem3);
+  m = a68_proc (M_BITS, M_LONG_BITS, NO_MOID);
+  a68_op (A68_STD, "SHORTEN", m, a68_lower_bitshorten2);
+  m = a68_proc (M_LONG_LONG_BITS, M_LONG_BITS, NO_MOID);
+  a68_op (A68_STD, "LENG", m,  a68_lower_bitleng2);
+  /* LONG LONG BITS operators  */
+  m = a68_proc (M_BOOL, M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
+  a68_op (A68_STD, "=", m, a68_lower_bit_eq3);
+  a68_op (A68_STD, "EQ", m, a68_lower_bit_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_bit_ne3);
+  a68_op (A68_STD, "NE", m, a68_lower_bit_ne3);
+  a68_op (A68_STD, "<=", m, a68_lower_bit_le3);
+  a68_op (A68_STD, "LE", m, a68_lower_bit_le3);
+  a68_op (A68_STD, ">=", m, a68_lower_bit_ge3);
+  a68_op (A68_STD, "GE", m, a68_lower_bit_ge3);
+  m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
+  a68_op (A68_STD, "NOT", m, a68_lower_bitnot2);
+  a68_op (A68_STD, "~", m, a68_lower_bitnot2);
+  m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
+  a68_op (A68_STD, "AND", m, a68_lower_bitand3);
+  a68_op (A68_STD, "OR", m, a68_lower_bitior3);
+  m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, M_INT, NO_MOID);
+  a68_op (A68_STD, "SHL", m, a68_lower_shl3);
+  a68_op (A68_STD, "UP", m, a68_lower_shl3);
+  a68_op (A68_STD, "SHR", m, a68_lower_shr3);
+  a68_op (A68_STD, "DOWN", m, a68_lower_shr3);
+  m = a68_proc (M_BOOL, M_INT, M_LONG_LONG_BITS, NO_MOID);
+  a68_op (A68_STD, "ELEM", m, a68_lower_bitelem3);
+  m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "BIN", m, a68_lower_bin2);
+  m = a68_proc (M_LONG_LONG_INT, M_LONG_LONG_BITS, NO_MOID);
+  a68_op (A68_STD, "ABS", m, a68_lower_bitabs2);
+  m = a68_proc (M_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
+  a68_op (A68_STD, "SHORTEN", m, a68_lower_bitshorten2);
+  /* REAL operators.  */
+  m = A68_MCACHE (proc_real_real);
+  a68_op (A68_STD, "+", m, a68_lower_confirm2);
+  a68_op (A68_STD, "-", m, a68_lower_negate2);
+  a68_op (A68_STD, "ABS", m, a68_lower_realabs2);
+  m = a68_proc (M_INT, M_REAL, NO_MOID);
+  a68_op (A68_STD, "SIGN", m, a68_lower_realsign2);
+  a68_op (A68_STD, "ROUND", m, a68_lower_round2);
+  a68_op (A68_STD, "ENTIER", m, a68_lower_entier2);
+  m = a68_proc (M_BOOL, M_REAL, M_REAL, NO_MOID);
+  a68_op (A68_STD, "=", m, a68_lower_real_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_real_ne3);
+  a68_op (A68_STD, "<", m, a68_lower_real_lt3);
+  a68_op (A68_STD, "<=", m, a68_lower_real_le3);
+  a68_op (A68_STD, ">", m, a68_lower_real_gt3);
+  a68_op (A68_STD, ">=", m, a68_lower_real_ge3);
+  a68_op (A68_STD, "EQ", m, a68_lower_real_eq3);
+  a68_op (A68_STD, "NE", m, a68_lower_real_ne3);
+  a68_op (A68_STD, "LT", m, a68_lower_real_lt3);
+  a68_op (A68_STD, "LE", m, a68_lower_real_le3);
+  a68_op (A68_STD, "GT", m, a68_lower_real_gt3);
+  a68_op (A68_STD, "GE", m, a68_lower_real_ge3);
+  m = A68_MCACHE (proc_real_real_real);
+  a68_op (A68_STD, "+", m, a68_lower_plus_real);
+  a68_op (A68_STD, "-", m, a68_lower_minus_real);
+  a68_op (A68_STD, "*", m, a68_lower_mult_real);
+  a68_op (A68_STD, "/", m, a68_lower_div3);
+  a68_op (A68_STD, "**", m, a68_lower_pow_real);
+  a68_op (A68_STD, "^", m, a68_lower_pow_real);
+  m = a68_proc (M_REAL, M_REAL, M_INT, NO_MOID);
+  a68_op (A68_STD, "**", m, a68_lower_pow_real);
+  a68_op (A68_STD, "^", m, a68_lower_pow_real);
+  m = a68_proc (M_REF_REAL, M_REF_REAL, M_REAL, NO_MOID);
+  a68_op (A68_STD, "+:=", m, a68_lower_plusab3);
+  a68_op (A68_STD, "-:=", m, a68_lower_minusab3);
+  a68_op (A68_STD, "*:=", m, a68_lower_multab3);
+  a68_op (A68_STD, "/:=", m, a68_lower_divab3);
+  a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3);
+  a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3);
+  a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3);
+  a68_op (A68_STD, "DIVAB", m, a68_lower_divab3);
+  m = a68_proc (M_LONG_REAL, M_REAL, NO_MOID);
+  a68_op (A68_STD, "LENG", m, a68_lower_lengreal2);
+  /* LONG REAL operators */
+  m = a68_proc (M_LONG_LONG_REAL, M_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "LENG", m, a68_lower_lengreal2);
+  m = a68_proc (M_REAL, M_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "SHORTEN", m, a68_lower_shortenreal2);
+  m = a68_proc (M_LONG_REAL, M_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_confirm2);
+  a68_op (A68_STD, "-", m, a68_lower_negate2);
+  a68_op (A68_STD, "ABS", m, a68_lower_realabs2);
+  m = a68_proc (M_INT, M_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "SIGN", m, a68_lower_realsign2);
+  m = a68_proc (M_LONG_INT, M_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "ENTIER", m, a68_lower_entier2);
+  a68_op (A68_STD, "ROUND", m, a68_lower_round2);
+  m = a68_proc (M_LONG_REAL, M_LONG_REAL, M_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_plus_real);
+  a68_op (A68_STD, "-", m, a68_lower_minus_real);
+  a68_op (A68_STD, "*", m, a68_lower_mult_real);
+  a68_op (A68_STD, "/", m, a68_lower_div3);
+  a68_op (A68_STD, "**", m, a68_lower_pow_real);
+  a68_op (A68_STD, "^", m, a68_lower_pow_real);
+  m = a68_proc (M_REF_LONG_REAL, M_REF_LONG_REAL, M_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "+:=", m, a68_lower_plusab3);
+  a68_op (A68_STD, "-:=", m, a68_lower_minusab3);
+  a68_op (A68_STD, "*:=", m, a68_lower_multab3);
+  a68_op (A68_STD, "/:=", m, a68_lower_divab3);
+  a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3);
+  a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3);
+  a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3);
+  a68_op (A68_STD, "DIVAB", m, a68_lower_divab3);
+  m = a68_proc (M_BOOL, M_LONG_REAL, M_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "=", m, a68_lower_real_eq3);
+  a68_op (A68_STD, "EQ", m, a68_lower_real_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_real_ne3);
+  a68_op (A68_STD, "NE", m, a68_lower_real_ne3);
+  a68_op (A68_STD, "<", m, a68_lower_real_lt3);
+  a68_op (A68_STD, "LT", m, a68_lower_real_lt3);
+  a68_op (A68_STD, "<=", m, a68_lower_real_le3);
+  a68_op (A68_STD, "LE", m, a68_lower_real_le3);
+  a68_op (A68_STD, ">", m, a68_lower_real_gt3);
+  a68_op (A68_STD, "GT", m, a68_lower_real_gt3);
+  a68_op (A68_STD, ">=", m, a68_lower_real_ge3);
+  a68_op (A68_STD, "GE", m, a68_lower_real_ge3);
+  m = a68_proc (M_LONG_REAL, M_LONG_REAL, M_INT, NO_MOID);
+  a68_op (A68_STD, "**", m, a68_lower_pow_real);
+  a68_op (A68_STD, "^", m, a68_lower_pow_real);
+  /* LONG LONG REAL operators. */
+  m = a68_proc (M_LONG_REAL, M_LONG_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "SHORTEN", m, a68_lower_shortenreal2);
+  m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "ABS", m, a68_lower_realabs2);
+  a68_op (A68_STD, "+", m, a68_lower_confirm2);
+  a68_op (A68_STD, "-", m, a68_lower_negate2);
+  m = a68_proc (M_INT, M_LONG_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "SIGN", m, a68_lower_realsign2);
+  m = a68_proc (M_LONG_LONG_INT, M_LONG_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "ENTIER", m, a68_lower_entier2);
+  a68_op (A68_STD, "ROUND", m, a68_lower_round2);
+  m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "+", m, a68_lower_plus_real);
+  a68_op (A68_STD, "-", m, a68_lower_minus_real);
+  a68_op (A68_STD, "*", m, a68_lower_mult_real);
+  a68_op (A68_STD, "/", m, a68_lower_div3);
+  a68_op (A68_STD, "**", m, a68_lower_pow_real);
+  a68_op (A68_STD, "^", m, a68_lower_pow_real);
+  m = a68_proc (M_REF_LONG_LONG_REAL, M_REF_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "+:=", m, a68_lower_plusab3);
+  a68_op (A68_STD, "-:=", m, a68_lower_minusab3);
+  a68_op (A68_STD, "*:=", m, a68_lower_multab3);
+  a68_op (A68_STD, "/:=", m, a68_lower_divab3);
+  a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3);
+  a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3);
+  a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3);
+  a68_op (A68_STD, "DIVAB", m, a68_lower_divab3);
+  m = a68_proc (M_BOOL, M_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "=", m, a68_lower_real_eq3);
+  a68_op (A68_STD, "EQ", m, a68_lower_real_eq3);
+  a68_op (A68_STD, "/=", m, a68_lower_real_ne3);
+  a68_op (A68_STD, "NE", m, a68_lower_real_ne3);
+  a68_op (A68_STD, "<", m, a68_lower_real_lt3);
+  a68_op (A68_STD, "LT", m, a68_lower_real_lt3);
+  a68_op (A68_STD, "<=", m, a68_lower_real_le3);
+  a68_op (A68_STD, "LE", m, a68_lower_real_le3);
+  a68_op (A68_STD, ">", m, a68_lower_real_gt3);
+  a68_op (A68_STD, "GT", m, a68_lower_real_gt3);
+  a68_op (A68_STD, ">=", m, a68_lower_real_ge3);
+  a68_op (A68_STD, "GE", m, a68_lower_real_ge3);
+  m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_REAL, M_INT, NO_MOID);
+  a68_op (A68_STD, "**", m, a68_lower_pow_real);
+  a68_op (A68_STD, "^", m, a68_lower_pow_real);
+  /* ROWS operators.  */
+  m = a68_proc (M_INT, M_ROWS, NO_MOID);
+  a68_op (A68_STD, "LWB", m, a68_lower_lwb2);
+  a68_op (A68_STD, "UPB", m, a68_lower_upb2);
+  m = a68_proc (M_INT, M_INT, M_ROWS, NO_MOID);
+  a68_op (A68_STD, "LWB", m, a68_lower_lwb3);
+  a68_op (A68_STD, "UPB", m, a68_lower_upb3);
+  /* BYTES operators.  */
+  m = a68_proc (M_BYTES, M_STRING, NO_MOID);
+  a68_idf (A68_STD, "bytespack", m);
+  m = a68_proc (M_CHAR, M_INT, M_BYTES, NO_MOID);
+  a68_op (A68_STD, "ELEM", m);
+  m = a68_proc (M_BYTES, M_BYTES, M_BYTES, NO_MOID);
+  a68_op (A68_STD, "+", m);
+  m = a68_proc (M_REF_BYTES, M_REF_BYTES, M_BYTES, NO_MOID);
+  a68_op (A68_STD, "+:=", m);
+  a68_op (A68_STD, "PLUSAB", m);
+  m = a68_proc (M_BOOL, M_BYTES, M_BYTES, NO_MOID);
+  a68_op (A68_STD, "=", m);
+  a68_op (A68_STD, "/=", m);
+  a68_op (A68_STD, "<", m);
+  a68_op (A68_STD, "<=", m);
+  a68_op (A68_STD, ">", m);
+  a68_op (A68_STD, ">=", m);
+  a68_op (A68_STD, "EQ", m);
+  a68_op (A68_STD, "NE", m);
+  a68_op (A68_STD, "LT", m);
+  a68_op (A68_STD, "LE", m);
+  a68_op (A68_STD, "GT", m);
+  a68_op (A68_STD, "GE", m);
+  /* LONG BYTES operators.  */
+  m = a68_proc (M_LONG_BYTES, M_BYTES, NO_MOID);
+  a68_op (A68_STD, "LENG", m);
+  m = a68_proc (M_BYTES, M_LONG_BYTES, NO_MOID);
+  a68_idf (A68_STD, "SHORTEN", m);
+  m = a68_proc (M_LONG_BYTES, M_STRING, NO_MOID);
+  a68_idf (A68_STD, "longbytespack", m);
+  m = a68_proc (M_CHAR, M_INT, M_LONG_BYTES, NO_MOID);
+  a68_op (A68_STD, "ELEM", m);
+  m = a68_proc (M_LONG_BYTES, M_LONG_BYTES, M_LONG_BYTES, NO_MOID);
+  a68_op (A68_STD, "+", m);
+  m = a68_proc (M_REF_LONG_BYTES, M_REF_LONG_BYTES, M_LONG_BYTES, NO_MOID);
+  a68_op (A68_STD, "+:=", m);
+  a68_op (A68_STD, "PLUSAB", m);
+  m = a68_proc (M_BOOL, M_LONG_BYTES, M_LONG_BYTES, NO_MOID);
+  a68_op (A68_STD, "=", m);
+  a68_op (A68_STD, "/=", m);
+  a68_op (A68_STD, "<", m);
+  a68_op (A68_STD, "<=", m);
+  a68_op (A68_STD, ">", m);
+  a68_op (A68_STD, ">=", m);
+  a68_op (A68_STD, "EQ", m);
+  a68_op (A68_STD, "NE", m);
+  a68_op (A68_STD, "LT", m);
+  a68_op (A68_STD, "LE", m);
+  a68_op (A68_STD, "GT", m);
+  a68_op (A68_STD, "GE", m);
+  /* COMPLEX operators.  */
+  m = a68_proc (M_COMPLEX, M_REAL, M_REAL, NO_MOID);
+  a68_op (A68_STD, "I", m, a68_lower_reali);
+  a68_op (A68_STD, "+*", m, a68_lower_reali);
+  m = a68_proc (M_COMPLEX, M_INT, M_INT, NO_MOID);
+  a68_op (A68_STD, "I", m, a68_lower_inti);
+  a68_op (A68_STD, "+*", m, a68_lower_inti);
+  m = a68_proc (M_REAL, M_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "RE", m, a68_lower_re2);
+  a68_op (A68_STD, "IM", m, a68_lower_im2);
+  a68_op (A68_STD, "ABS", m);
+  a68_op (A68_STD, "ARG", m);
+  m = A68_MCACHE (proc_complex_complex);
+  a68_op (A68_STD, "+", m);
+  a68_op (A68_STD, "-", m);
+  a68_op (A68_STD, "CONJ", m, a68_lower_conj2);
+  m = a68_proc (M_BOOL, M_COMPLEX, M_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "=", m);
+  a68_op (A68_STD, "/=", m);
+  a68_op (A68_STD, "EQ", m);
+  a68_op (A68_STD, "NE", m);
+  m = a68_proc (M_COMPLEX, M_COMPLEX, M_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "+", m);
+  a68_op (A68_STD, "-", m);
+  a68_op (A68_STD, "*", m);
+  a68_op (A68_STD, "/", m);
+  m = a68_proc (M_COMPLEX, M_COMPLEX, M_INT, NO_MOID);
+  a68_op (A68_STD, "**", m);
+  a68_op (A68_STD, "UP", m);
+  a68_op (A68_STD, "^", m);
+  m = a68_proc (M_REF_COMPLEX, M_REF_COMPLEX, M_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "+:=", m);
+  a68_op (A68_STD, "-:=", m);
+  a68_op (A68_STD, "*:=", m);
+  a68_op (A68_STD, "/:=", m);
+  a68_op (A68_STD, "PLUSAB", m);
+  a68_op (A68_STD, "MINUSAB", m);
+  a68_op (A68_STD, "TIMESAB", m);
+  a68_op (A68_STD, "DIVAB", m);
+  m = a68_proc (M_COMPLEX, M_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "SHORTEN", m);
+  /* LONG COMPLEX  operators */
+  m = a68_proc (M_LONG_COMPLEX, M_LONG_INT, M_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "I", m, a68_lower_longinti);
+  a68_op (A68_STD, "+*", m, a68_lower_longinti);
+  m = a68_proc (M_LONG_COMPLEX, M_LONG_REAL, M_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "I", m, a68_lower_longreali);
+  a68_op (A68_STD, "+*", m, a68_lower_longreali);
+  m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "LENG", m);
+  m = a68_proc (M_LONG_COMPLEX, M_LONG_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "SHORTEN", m);
+  m = a68_proc (M_LONG_COMPLEX, M_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "LENG", m);
+  m = a68_proc (M_COMPLEX, M_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "SHORTEN", m);
+  m = a68_proc (M_LONG_REAL, M_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "RE", m, a68_lower_re2);
+  a68_op (A68_STD, "IM", m, a68_lower_im2);
+  a68_op (A68_STD, "ARG", m);
+  a68_op (A68_STD, "ABS", m);
+  m = a68_proc (M_LONG_COMPLEX, M_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "+", m);
+  a68_op (A68_STD, "-", m);
+  a68_op (A68_STD, "CONJ", m, a68_lower_conj2);
+  m = a68_proc (M_LONG_COMPLEX, M_LONG_COMPLEX, M_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "+", m);
+  a68_op (A68_STD, "-", m);
+  a68_op (A68_STD, "*", m);
+  a68_op (A68_STD, "/", m);
+  m = a68_proc (M_LONG_COMPLEX, M_LONG_COMPLEX, M_INT, NO_MOID);
+  a68_op (A68_STD, "**", m);
+  a68_op (A68_STD, "UP", m);
+  a68_op (A68_STD, "^", m);
+  m = a68_proc (M_BOOL, M_LONG_COMPLEX, M_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "=", m);
+  a68_op (A68_STD, "EQ", m);
+  a68_op (A68_STD, "/=", m);
+  a68_op (A68_STD, "NE", m);
+  m = a68_proc (M_REF_LONG_COMPLEX, M_REF_LONG_COMPLEX, M_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "+:=", m);
+  a68_op (A68_STD, "-:=", m);
+  a68_op (A68_STD, "*:=", m);
+  a68_op (A68_STD, "/:=", m);
+  a68_op (A68_STD, "PLUSAB", m);
+  a68_op (A68_STD, "MINUSAB", m);
+  a68_op (A68_STD, "TIMESAB", m);
+  a68_op (A68_STD, "DIVAB", m);
+  /* LONG LONG COMPLEX operators.  */
+  m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_LONG_INT, M_LONG_LONG_INT, NO_MOID);
+  a68_op (A68_STD, "I", m, a68_lower_longlonginti);
+  a68_op (A68_STD, "+*", m, a68_lower_longlonginti);
+  m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID);
+  a68_op (A68_STD, "I", m, a68_lower_longlongreali);
+  a68_op (A68_STD, "+*", m, a68_lower_longlongreali);
+  m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "RE", m, a68_lower_re2);
+  a68_op (A68_STD, "IM", m, a68_lower_im2);
+  a68_op (A68_STD, "ARG", m);
+  a68_op (A68_STD, "ABS", m);
+  m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "+", m);
+  a68_op (A68_STD, "-", m);
+  a68_op (A68_STD, "CONJ", m, a68_lower_conj2);
+  m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "+", m);
+  a68_op (A68_STD, "-", m);
+  a68_op (A68_STD, "*", m);
+  a68_op (A68_STD, "/", m);
+  m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, M_INT, NO_MOID);
+  a68_op (A68_STD, "**", m);
+  a68_op (A68_STD, "UP", m);
+  a68_op (A68_STD, "^", m);
+  m = a68_proc (M_BOOL, M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "=", m);
+  a68_op (A68_STD, "EQ", m);
+  a68_op (A68_STD, "/=", m);
+  a68_op (A68_STD, "NE", m);
+  m = a68_proc (M_REF_LONG_LONG_COMPLEX, M_REF_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "+:=", m);
+  a68_op (A68_STD, "-:=", m);
+  a68_op (A68_STD, "*:=", m);
+  a68_op (A68_STD, "/:=", m);
+  a68_op (A68_STD, "PLUSAB", m);
+  a68_op (A68_STD, "MINUSAB", m);
+  a68_op (A68_STD, "TIMESAB", m);
+  a68_op (A68_STD, "DIVAB", m);
+  m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, NO_MOID);
+  a68_op (A68_STD, "LENG", m);
+  /* SEMA operators.  */
+  m = a68_proc (M_SEMA, M_INT, NO_MOID);
+  a68_op (A68_STD, "LEVEL", m);
+  m = a68_proc (M_INT, M_SEMA, NO_MOID);
+  a68_op (A68_STD, "LEVEL", m);
+  m = a68_proc (M_VOID, M_SEMA, NO_MOID);
+  a68_op (A68_STD, "UP", m);
+  a68_op (A68_STD, "DOWN", m);
+}
+
+/* GNU extensions for the standenv.  */
+
+static void
+gnu_prelude (void)
+{
+  MOID_T *m = NO_MOID;
+  /* Priorities.  */
+  a68_prio ("ELEMS", 8);
+  /* Identifiers.  */
+  a68_idf (A68_EXT, "infinity", M_REAL, a68_lower_infinity);
+  a68_idf (A68_EXT, "minusinfinity", M_REAL, a68_lower_minusinfinity);
+  a68_idf (A68_EXT, "longlonginfinity", M_LONG_LONG_REAL);
+  a68_idf (A68_EXT, "longlongminusinfinity", M_LONG_LONG_REAL);
+  a68_idf (A68_EXT, "longinfinity", M_LONG_REAL);
+  a68_idf (A68_EXT, "longminusinfinity", M_LONG_REAL);
+  a68_idf (A68_EXT, "minint", M_INT, a68_lower_minint);
+  a68_idf (A68_EXT, "longminint", M_LONG_INT, a68_lower_minint);
+  a68_idf (A68_EXT, "longlongminint", M_LONG_LONG_INT, a68_lower_minint);
+  a68_idf (A68_EXT, "shortminint", M_SHORT_INT, a68_lower_minint);
+  a68_idf (A68_EXT, "shortshortminint", M_SHORT_SHORT_INT, a68_lower_minint);
+  a68_idf (A68_EXT, "minreal", M_REAL, a68_lower_minreal);
+  a68_idf (A68_EXT, "longminreal", M_LONG_REAL, a68_lower_minreal);
+  a68_idf (A68_EXT, "longlongminreal", M_LONG_LONG_REAL, a68_lower_minreal);
+  a68_idf (A68_EXT, "invalidchar", M_CHAR, a68_lower_invalidchar);
+  /* REAL procedures.  */
+  m = A68_MCACHE (proc_real_real);
+  a68_idf (A68_EXT, "log", m, a68_lower_log);
+  /* LONG REAL procedures.  */
+  m = a68_proc (M_LONG_REAL, M_LONG_REAL, NO_MOID);
+  a68_idf (A68_EXT, "longlog", m, a68_lower_long_log);
+  /* LONG LONG REAL procedures.  */
+  m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID);
+  a68_idf (A68_EXT, "longlonglog", m, a68_lower_long_long_log);
+  /* BOOL operators.  */
+  m = a68_proc (M_BOOL, M_BOOL, M_BOOL, NO_MOID);
+  a68_op (A68_EXT, "XOR", m, a68_lower_xor3);
+  /* SHORT SHORT BITS operators.  */
+  m = a68_proc (M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, NO_MOID);
+  a68_op (A68_EXT, "XOR", m, a68_lower_bitxor3);
+  /* SHORT BITS operators.  */
+  m = a68_proc (M_SHORT_BITS, M_SHORT_BITS, M_SHORT_BITS, NO_MOID);
+  a68_op (A68_EXT, "XOR", m, a68_lower_bitxor3);
+  /* BITS operators.  */
+  m = a68_proc (M_BITS, M_BITS, M_BITS, NO_MOID);
+  a68_op (A68_EXT, "XOR", m, a68_lower_bitxor3);
+  /* LONG BITS operators.  */
+  m = a68_proc (M_LONG_BITS, M_LONG_BITS, M_LONG_BITS, NO_MOID);
+  a68_op (A68_EXT, "XOR", m, a68_lower_bitxor3);
+  /* LONG LONG BITS operators.  */
+  m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID);
+  a68_op (A68_EXT, "XOR", m, a68_lower_bitxor3);
+  /* ROWS operators.  */
+  m = a68_proc (M_INT, M_ROWS, NO_MOID);
+  a68_op (A68_EXT, "ELEMS", m, a68_lower_elems2);
+  m = a68_proc (M_INT, M_INT, M_ROWS, NO_MOID);
+  a68_op (A68_EXT, "ELEMS", m, a68_lower_elems3);
+}
+
+/* POSIX prelude.  */
+
+static void
+posix_prelude (void)
+{
+  MOID_T *m = NO_MOID;
+
+  /* Environment variables.  */
+  m = a68_proc (M_STRING, M_STRING, NO_MOID);
+  a68_idf (A68_EXT, "getenv", m, a68_lower_posixgetenv);
+  /* Exit status handling.  */
+  m = a68_proc (M_VOID, M_INT, NO_MOID);
+  a68_idf (A68_EXT, "setexitstatus", m, a68_lower_setexitstatus);
+  /* Argument handling.  */
+  m = A68_MCACHE (proc_int);
+  a68_idf (A68_EXT, "argc", m, a68_lower_posixargc);
+  m = a68_proc (M_STRING, M_INT, NO_MOID);
+  a68_idf (A68_EXT, "argv", m, a68_lower_posixargv);
+  /* Error procedures.  */
+  m = A68_MCACHE (proc_int);
+  a68_idf (A68_EXT, "errno", m, a68_lower_posixerrno);
+  m = a68_proc (M_VOID, M_STRING, NO_MOID);
+  a68_idf (A68_EXT, "perror", m, a68_lower_posixperror);
+  m = a68_proc (M_STRING, M_INT, NO_MOID);
+  a68_idf (A68_EXT, "strerror", m, a68_lower_posixstrerror);
+  /* I/O identifiers.  */
+  a68_idf (A68_EXT, "stdin", M_INT, a68_lower_posixstdinfiledes);
+  a68_idf (A68_EXT, "stdout", M_INT, a68_lower_posixstdoutfiledes);
+  a68_idf (A68_EXT, "stderr", M_INT, a68_lower_posixstderrfiledes);
+  a68_idf (A68_EXT, "fileodefault", M_BITS, a68_lower_posixfileodefault);
+  a68_idf (A68_EXT, "fileordwr", M_BITS, a68_lower_posixfileordwr);
+  a68_idf (A68_EXT, "fileordonly", M_BITS, a68_lower_posixfileordonly);
+  a68_idf (A68_EXT, "fileowronly", M_BITS, a68_lower_posixfileowronly);
+  a68_idf (A68_EXT, "fileotrunc", M_BITS, a68_lower_posixfileotrunc);
+  /* Opening and closing files.  */
+  m = a68_proc (M_INT, M_STRING, M_BITS, NO_MOID);
+  a68_idf (A68_EXT, "fopen", m, a68_lower_posixfopen);
+  a68_idf (A68_EXT, "fcreate", m, a68_lower_posixfcreate);
+  m = A68_MCACHE (proc_int_int);
+  a68_idf (A68_EXT, "fclose", m, a68_lower_posixfclose);
+  /* Getting properties of files.  */
+  m = a68_proc (M_LONG_LONG_INT, M_INT, NO_MOID);
+  a68_idf (A68_EXT, "fsize", m, a68_lower_posixfsize);
+  /* Sockets.  */
+  m = a68_proc (M_INT, M_STRING, M_INT, NO_MOID);
+  a68_idf (A68_EXT, "fconnect", m, a68_lower_posixfconnect);
+  /* String and character output.  */
+  m = a68_proc (M_CHAR, M_CHAR, NO_MOID);
+  a68_idf (A68_EXT, "putchar", m, a68_lower_posixputchar);
+  m = a68_proc (M_VOID, M_STRING, NO_MOID);
+  a68_idf (A68_EXT, "puts", m, a68_lower_posixputs);
+  m = a68_proc (M_CHAR, M_INT, M_CHAR, NO_MOID);
+  a68_idf (A68_EXT, "fputc", m, a68_lower_posixfputc);
+  m = a68_proc (M_INT, M_INT, M_STRING, NO_MOID);
+  a68_idf (A68_EXT, "fputs", m, a68_lower_posixfputs);
+  /* String and character input.  */
+  m = A68_MCACHE (proc_char);
+  a68_idf (A68_EXT, "getchar", m, a68_lower_posixgetchar);
+  m = a68_proc (M_CHAR, M_INT, NO_MOID);
+  a68_idf (A68_EXT, "fgetc", m, a68_lower_posixfgetc);
+  m = a68_proc (M_REF_STRING, M_INT, NO_MOID);
+  a68_idf (A68_EXT, "gets", m, a68_lower_posixgets);
+  m = a68_proc (M_REF_STRING, M_INT, M_INT, NO_MOID);
+  a68_idf (A68_EXT, "fgets", m, a68_lower_posixfgets);
+}
+
+/* Transput.  */
+
+static void
+stand_transput (void)
+{
+  PACK_T *z = NO_PACK;
+  MOID_T *m = NO_MOID;
+
+  /* Modes.  */
+
+  /* NUMBER  */
+  z = NO_PACK;
+  (void) a68_add_mode_to_pack (&z, M_INT, NO_TEXT, NO_NODE);
+  (void) a68_add_mode_to_pack (&z, M_LONG_INT, NO_TEXT, NO_NODE);
+  (void) a68_add_mode_to_pack (&z, M_LONG_LONG_INT, NO_TEXT, NO_NODE);
+  (void) a68_add_mode_to_pack (&z, M_SHORT_INT, NO_TEXT, NO_NODE);
+  (void) a68_add_mode_to_pack (&z, M_SHORT_SHORT_INT, NO_TEXT, NO_NODE);
+  (void) a68_add_mode_to_pack (&z, M_REAL, NO_TEXT, NO_NODE);
+  (void) a68_add_mode_to_pack (&z, M_LONG_REAL, NO_TEXT, NO_NODE);
+  (void) a68_add_mode_to_pack (&z, M_LONG_LONG_REAL, NO_TEXT, NO_NODE);
+  M_NUMBER = a68_add_mode (&TOP_MOID (&A68_JOB), UNION_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z);
+
+  /* Layout procedures.  */
+
+  /* Conversion procedures.  */
+  m = a68_proc (M_STRING, M_NUMBER, M_INT, NO_MOID);
+  a68_idf (A68_STD, "whole", m);
+}
+
+/* Build the standard environ symbol table.  */
+
+void
+a68_make_standard_environ (void)
+{
+  stand_moids ();
+  A68_MCACHE (proc_bool) = a68_proc (M_BOOL, NO_MOID);
+  A68_MCACHE (proc_char) = a68_proc (M_CHAR, NO_MOID);
+  A68_MCACHE (proc_complex_complex) = a68_proc (M_COMPLEX, M_COMPLEX, NO_MOID);
+  A68_MCACHE (proc_int) = a68_proc (M_INT, NO_MOID);
+  A68_MCACHE (proc_int_int) = a68_proc (M_INT, M_INT, NO_MOID);
+  A68_MCACHE (proc_int_int_real) = a68_proc (M_REAL, M_INT, M_INT, NO_MOID);
+  A68_MCACHE (proc_int_real) = a68_proc (M_REAL, M_INT, NO_MOID);
+  A68_MCACHE (proc_int_real_real) = a68_proc (M_REAL, M_INT, M_REAL, NO_MOID);
+  A68_MCACHE (proc_int_real_real_real) = a68_proc (M_REAL, M_INT, M_REAL, M_REAL, NO_MOID);
+  A68_MCACHE (proc_real) = a68_proc (M_REAL, NO_MOID);
+  A68_MCACHE (proc_real_int_real) = a68_proc (M_REAL, M_REAL, M_INT, NO_MOID);
+  A68_MCACHE (proc_real_real_int_real) = a68_proc (M_REAL, M_REAL, M_REAL, M_INT, NO_MOID);
+  A68_MCACHE (proc_real_real) = M_PROC_REAL_REAL;
+  A68_MCACHE (proc_real_real_real) = a68_proc (M_REAL, M_REAL, M_REAL, NO_MOID);
+  A68_MCACHE (proc_real_real_real_int) = a68_proc (M_INT, M_REAL, M_REAL, M_REAL, NO_MOID);
+  A68_MCACHE (proc_real_real_real_real) = a68_proc (M_REAL, M_REAL, M_REAL, M_REAL, NO_MOID);
+  A68_MCACHE (proc_real_real_real_real_real) = a68_proc (M_REAL, M_REAL, M_REAL, M_REAL, M_REAL, NO_MOID);
+  A68_MCACHE (proc_real_real_real_real_real_real) = a68_proc (M_REAL, M_REAL, M_REAL, M_REAL, M_REAL, M_REAL, NO_MOID);
+  A68_MCACHE (proc_real_ref_real_ref_int_void) = a68_proc (M_VOID, M_REAL, M_REF_REAL, M_REF_INT, NO_MOID);
+  A68_MCACHE (proc_void) = a68_proc (M_VOID, NO_MOID);
+  stand_prelude ();
+  if (!OPTION_STRICT (&A68_JOB))
+    {
+      gnu_prelude ();
+      posix_prelude ();
+    }
+  stand_transput ();
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-scanner.cc
@@ -0,0 +1,2277 @@
+/* Context-dependent ALGOL 68 tokeniser.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+/* Context-dependent ALGOL 68 tokeniser.  */
+
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "diagnostic.h"
+#include "options.h"
+#include "vec.h"
+
+#include "a68.h"
+
+/* A few forward references of static functions defined in this file.  */
+
+static void include_files (LINE_T *top);
+
+/* Standard prelude and postlude for source files.
+
+   We need several versions for the several supported stropping regimes.  */
+
+static const char *
+upper_prelude_start[] = {
+  "BEGIN",
+  "      BEGIN",
+  NO_TEXT
+};
+
+static const char *
+upper_postlude[] = {
+  "      END;",
+  "      stop: SKIP",
+  "END",
+  NO_TEXT
+};
+
+static const char *
+supper_prelude_start[] = {
+  "begin",
+  "     begin",
+  NO_TEXT
+};
+
+static const char *
+supper_postlude[] = {
+  "      end;",
+  "      stop: skip",
+  "end",
+  NO_TEXT
+};
+
+/* Macros.  */
+
+#define NULL_CHAR '\0'
+#define STOP_CHAR 127
+#define FORMFEED_CHAR '\f'
+#define CR_CHAR '\r'
+#define QUOTE_CHAR '"'
+#define APOSTROPHE_CHAR '\''
+#define BACKSLASH_CHAR '\\'
+#define NEWLINE_CHAR '\n'
+#define EXPONENT_CHAR 'e'
+#define RADIX_CHAR 'r'
+#define POINT_CHAR '.'
+#define TAB_CHAR '\t'
+
+#define MAX_RESTART 256
+
+#define EOL(c) ((c) == NEWLINE_CHAR || (c) == NULL_CHAR)
+#define SCAN_ERROR(c, u, v, txt) if (c)		\
+    do						\
+      {						\
+	a68_scan_error (u, v, txt);		\
+      }						\
+    while (0)
+
+
+#define SCAN_DIGITS(c)				\
+  while (ISDIGIT (c))				\
+    {						\
+      (sym++)[0] = (c);				\
+      (c) = next_char (ref_l, ref_s, true);	\
+    }
+
+#define SCAN_EXPONENT_PART(c)						\
+  do									\
+    {									\
+      (sym++)[0] = EXPONENT_CHAR;					\
+      (c) = next_char (ref_l, ref_s, true);				\
+      if ((c) == '+' || (c) == '-') {					\
+	(sym++)[0] = (c);						\
+	(c) = next_char (ref_l, ref_s, true);				\
+      }									\
+      SCAN_ERROR (!ISDIGIT (c), *start_l, *start_c,			\
+		  "invalid exponent digit");				\
+      SCAN_DIGITS (c);							\
+    }									\
+  while (0)
+
+/* Read bytes from file into buffer.  */
+
+static ssize_t
+io_read (FILE *file, void *buf, size_t n)
+{
+  int fd = fileno (file);
+  size_t to_do = n;
+  int restarts = 0;
+  char *z = (char *) buf;
+  while (to_do > 0)
+    {
+      ssize_t bytes_read;
+
+      errno = 0;
+      bytes_read = read (fd, z, to_do);
+      if (bytes_read < 0)
+	{
+	  if (errno == EINTR)
+	    {
+	      /* interrupt, retry.  */
+	      bytes_read = 0;
+	      if (restarts++ > MAX_RESTART)
+		{
+		  return -1;
+		}
+	    }
+	  else
+	    {
+	      /* read error.  */
+	      return -1;
+	    }
+	}
+      else if (bytes_read == 0)
+	{
+	  /* EOF_CHAR */
+	  break;
+	}
+      to_do -= (size_t) bytes_read;
+      z += bytes_read;
+    }
+
+  /* return >= 0  */
+  return (ssize_t) n - (ssize_t) to_do;
+}
+
+/* Save scanner state, for character look-ahead.  */
+
+static void
+save_state (LINE_T *ref_l, char *ref_s, char ch)
+{
+  SCAN_STATE_L (&A68_JOB) = ref_l;
+  SCAN_STATE_S (&A68_JOB) = ref_s;
+  SCAN_STATE_C (&A68_JOB) = ch;
+}
+
+/* Restore scanner state, for character look-ahead.  */
+
+static void
+restore_state (LINE_T **ref_l, char **ref_s, char *ch)
+{
+  *ref_l = SCAN_STATE_L (&A68_JOB);
+  *ref_s = SCAN_STATE_S (&A68_JOB);
+  *ch = SCAN_STATE_C (&A68_JOB);
+}
+
+/* New_source_line.  */
+
+static LINE_T *
+new_source_line (void)
+{
+  LINE_T *z = (LINE_T *) xmalloc (sizeof (LINE_T));
+
+  MARKER (z)[0] = '\0';
+  STRING (z) = NO_TEXT;
+  FILENAME (z) = NO_TEXT;
+  NUMBER (z) = 0;
+  NEXT (z) = NO_LINE;
+  PREVIOUS (z) = NO_LINE;
+  return z;
+}
+
+/* Append a source line to the internal source file.  */
+
+static void
+append_source_line (const char *str, LINE_T **ref_l, int *line_num,
+		    const char *filename)
+{
+  LINE_T *z = new_source_line ();
+
+  /* Link line into the chain.  */
+  STRING (z) = xstrdup (str);
+  FILENAME (z) = filename;
+  NUMBER (z) = (*line_num)++;
+  NEXT (z) = NO_LINE;
+  PREVIOUS (z) = *ref_l;
+  if (TOP_LINE (&A68_JOB) == NO_LINE)
+    TOP_LINE (&A68_JOB) = z;
+  if (*ref_l != NO_LINE)
+    NEXT (*ref_l) = z;
+  *ref_l = z;
+}
+
+/* Append environment source lines.  */
+
+static void
+append_environ (const char *str[], LINE_T **ref_l, int *line_num, const char *name)
+{
+  for (int k = 0; str[k] != NO_TEXT; k++)
+    {
+      int zero_line_num = 0;
+      (*line_num)++;
+      append_source_line (str[k], ref_l, &zero_line_num, name);
+    }
+}
+
+/*
+ * Scanner, tokenises the source code.
+ */
+
+/* Emit a diagnostic if CH is an unworthy character.  */
+
+static void
+unworthy (LINE_T *u, char *v, char ch)
+{
+  if (ISPRINT (ch))
+    {
+      if (snprintf (A68 (edit_line), SNPRINTF_SIZE, "*%s",
+		    "unworthy character") < 0)
+	gcc_unreachable ();
+    }
+  else
+    {
+      if (snprintf (A68 (edit_line), SNPRINTF_SIZE, "*%s %c",
+		    "unworthy character", ch) < 0)
+	gcc_unreachable ();
+    }
+
+  a68_scan_error (u, v, A68 (edit_line));
+}
+
+/* Concatenate lines that terminate in '\' with next line.  */
+
+static void
+concatenate_lines (LINE_T * top)
+{
+  LINE_T *q;
+  /* Work from bottom backwards.  */
+  for (q = top; q != NO_LINE && NEXT (q) != NO_LINE; FORWARD (q))
+    ;
+
+  for (; q != NO_LINE; BACKWARD (q))
+    {
+      char *z = STRING (q);
+      size_t len = strlen (z);
+
+      if (len >= 2
+	  && z[len - 2] == BACKSLASH_CHAR
+	  && z[len - 1] == NEWLINE_CHAR
+	  && NEXT (q) != NO_LINE
+	  && STRING (NEXT (q)) != NO_TEXT)
+	{
+	  z[len - 2] = '\0';
+	  len += (int) strlen (STRING (NEXT (q)));
+	  z = (char *) xmalloc (len + 1);
+	  a68_bufcpy (z, STRING (q), len + 1);
+	  a68_bufcat (z, STRING (NEXT (q)), len + 1);
+	  STRING (NEXT (q))[0] = '\0';
+	  STRING (q) = z;
+	}
+    }
+}
+
+/* Size of source file.  */
+
+static int
+get_source_size (void)
+{
+  FILE *f = FILE_SOURCE_FD (&A68_JOB);
+  return (int) lseek (fileno (f), 0, SEEK_END);
+}
+
+/* Read source file FILENAME and make internal copy.  */
+
+static bool
+read_source_file (const char *filename)
+{
+  struct stat statbuf;
+  LINE_T *ref_l = NO_LINE;
+  int line_num = 0;
+  size_t k;
+  size_t bytes_read;
+  ssize_t l;
+  size_t source_file_size;
+  char *buffer;
+  FILE *f;
+  bool ret = true;
+
+  /* First open the given file.  */
+  if (!(FILE_SOURCE_FD (&A68_JOB) = fopen (filename, "r")))
+    fatal_error (UNKNOWN_LOCATION, "could not open source file %s",
+		 filename);
+  FILE_SOURCE_NAME (&A68_JOB) = xstrdup (filename);
+  f = FILE_SOURCE_FD (&A68_JOB);
+
+  if (fstat (fileno (f), &statbuf)
+      || !(S_ISREG (statbuf.st_mode) || S_ISCHR (statbuf.st_mode)))
+    fatal_error (UNKNOWN_LOCATION, "specified file %s is a directory",
+		 filename);
+
+  if ((source_file_size = get_source_size ()) == 0)
+    {
+      /* The source file is empty.  */
+      ret = false;
+      goto done;
+    }
+
+  /* Allocate A68_PARSER (scan_buf), which is an auxiliary buffer used by the
+     scanner known to be big enough to hold any string contained in the source
+     file.  */
+  A68_PARSER (max_scan_buf_length) = source_file_size + 1;
+  A68_PARSER (max_scan_buf_length) += 1024; /* For the environment.  */
+  A68_PARSER (scan_buf) = (char *) xmalloc (A68_PARSER (max_scan_buf_length));
+
+  /* Prelude.  */
+  append_environ (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING
+		  ? upper_prelude_start : supper_prelude_start,
+		  &ref_l, &line_num, "prelude");
+
+  /* Read the file into a single buffer, so we save on system calls.  */
+  line_num = 1;
+  errno = 0;
+  buffer = (char *) xmalloc (8 + source_file_size);
+  if (lseek (fileno (f), 0, SEEK_SET) < 0)
+    gcc_unreachable ();
+  errno = 0;
+  bytes_read = io_read (f, buffer, source_file_size);
+  gcc_assert (errno == 0 && bytes_read == source_file_size);
+
+  /* Link all lines into the list.  */
+  k = 0;
+  while (k < source_file_size)
+    {
+      l = 0;
+      A68_PARSER (scan_buf)[0] = '\0';
+      while (k < source_file_size  && buffer[k] != NEWLINE_CHAR)
+	{
+	  if (k < source_file_size - 1
+	      && buffer[k] == CR_CHAR && buffer[k + 1] == NEWLINE_CHAR)
+	    k++;
+	  else
+	    {
+	      A68_PARSER (scan_buf)[l++] = buffer[k++];
+	      A68_PARSER (scan_buf)[l] = '\0';
+	    }
+	}
+      A68_PARSER (scan_buf)[l++] = NEWLINE_CHAR;
+      A68_PARSER (scan_buf)[l] = '\0';
+      if (k < source_file_size)
+	k++;
+      append_source_line (A68_PARSER (scan_buf), &ref_l, &line_num,
+			  FILE_SOURCE_NAME (&A68_JOB));
+      SCAN_ERROR (l != (ssize_t) strlen (A68_PARSER (scan_buf)),
+		  NO_LINE, NO_TEXT, "invalid characters in source file");
+    }
+
+  /* Postlude.  */
+  append_environ (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING
+		  ? upper_postlude : supper_postlude,
+		  &ref_l, &line_num, "postlude");
+
+  /* Concatenate lines that end with \.  */
+  concatenate_lines (TOP_LINE (&A68_JOB));
+
+  /* Include files.  */
+  include_files (TOP_LINE (&A68_JOB));
+
+ done:
+  if (fclose (FILE_SOURCE_FD (&A68_JOB)) != 0)
+    gcc_unreachable ();
+  return ret;
+}
+
+/* Get next character from internal copy of source file.
+
+   If ALLOW_TYPO is true then typographical display features are skipped.
+
+   If ALLOW_ONE_UNDER is true then a single underscore character is
+   skipped.  */
+
+static char
+next_char (LINE_T **ref_l, char **ref_s, bool allow_typo,
+	   bool allow_one_under = false, bool *found_under = NULL)
+{
+  char ch;
+
+  /* Empty source.  */
+  if (*ref_l == NO_LINE)
+    return STOP_CHAR;
+
+  if ((*ref_s)[0] == NEWLINE_CHAR || (*ref_s)[0] == '\0')
+    {
+      /* Go to new line.  */
+      *ref_l = NEXT (*ref_l);
+      if (*ref_l == NO_LINE)
+        return STOP_CHAR;
+      *ref_s = STRING (*ref_l);
+    }
+  else
+    (*ref_s)++;
+
+  /* Deliver next char.  */
+  ch = (*ref_s)[0];
+  if ((allow_typo && (ISSPACE (ch) || ch == FORMFEED_CHAR))
+      || (allow_one_under && ch == '_'))
+    {
+      if (ch == '_' && found_under != NULL)
+	*found_under = true;
+      ch = next_char (ref_l, ref_s, allow_typo);
+    }
+  return ch;
+}
+
+/* Find first character that can start a valid symbol.  */
+
+static void
+get_good_char (char *ref_c, LINE_T **ref_l, char **ref_s)
+{
+  while (*ref_c != STOP_CHAR && (ISSPACE (*ref_c) || (*ref_c == '\0')))
+    *ref_c = next_char (ref_l, ref_s, false);
+}
+
+/* Case insensitive strncmp for at most the number of chars in V.  */
+
+static int
+streq (const char *u, const char *v)
+{
+  int diff;
+  for (diff = 0; diff == 0 && u[0] != NULL_CHAR && v[0] != NULL_CHAR; u++, v++)
+    diff = ((int) TOLOWER (u[0])) - ((int) TOLOWER (v[0]));
+  return diff;
+}
+
+/* Case insensitive strncmp for at most N chars.  */
+
+static int
+strneq (const char *u, const char *v, size_t n)
+{
+  int diff;
+  size_t pos = 0;
+  for (diff = 0;
+       diff == 0 && u[0] != NULL_CHAR && v[0] != NULL_CHAR && pos < n;
+       u++, v++, pos++)
+    diff = ((int) TOLOWER (u[0])) - ((int) TOLOWER (v[0]));
+  return diff;
+}
+
+
+/* Determine whether u is bold tag v, independent of stropping regime.  */
+
+static bool
+is_bold (char *u, const char *v)
+{
+  size_t len = strlen (v);
+
+  if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING)
+    /* UPPER stropping.  */
+    return strncmp (u, v, len) == 0 && !ISUPPER (u[len]);
+  else
+    /* SUPPER stropping.  */
+    return (strlen (u) >= len
+	    && ISLOWER (u[0])
+	    && strneq (u, v, len) == 0
+	    && !ISALPHA (u[len])
+	    && !ISDIGIT (u[len]));
+}
+
+/* Skip a string denotation.
+
+   This function returns true if the end of the string denotation is found.
+   Returns false otherwise.  */
+
+static bool
+skip_string (LINE_T **top, char **ch)
+{
+  LINE_T *u = *top;
+  char *v = *ch;
+  v++;
+  while (u != NO_LINE)
+    {
+      while (v[0] != NULL_CHAR)
+	{
+	  if (v[0] == QUOTE_CHAR && v[1] != QUOTE_CHAR)
+	    {
+	      *top = u;
+	      *ch = &v[1];
+	      return true;
+	    }
+	  else if (v[0] == QUOTE_CHAR && v[1] == QUOTE_CHAR)
+	    {
+	      v += 2;
+	    }
+	  else
+	    {
+	      v++;
+	    }
+	}
+      FORWARD (u);
+      if (u != NO_LINE) {
+	v = &(STRING (u)[0]);
+      } else {
+	v = NO_TEXT;
+      }
+    }
+  return false;
+}
+
+/* Skip a comment.
+
+   This function returns true if the end of the comment is found.  Returns
+   false otherwise.  */
+
+static bool
+skip_comment (LINE_T **top, char **ch, int delim)
+{
+  LINE_T *u = *top;
+  char *v = *ch;
+  int nesting_level = 1;
+  v++;
+  while (u != NO_LINE)
+    {
+      while (v[0] != NULL_CHAR)
+	{
+	  LINE_T *l = u;
+	  char *c = v;
+
+	  if (v[0] == QUOTE_CHAR && skip_string (&l, &c)
+	      && (delim == BOLD_COMMENT_BEGIN_SYMBOL || delim == BRIEF_COMMENT_BEGIN_SYMBOL))
+	    {
+	      u = l;
+	      v = c;
+	    }
+	  else if (is_bold (v, "COMMENT") && delim == BOLD_COMMENT_SYMBOL)
+	    {
+	      *top = u;
+	      *ch = &v[1];
+	      return true;
+	    }
+	  else if (is_bold (v, "CO") && delim == STYLE_I_COMMENT_SYMBOL)
+	    {
+	      *top = u;
+	      *ch = &v[1];
+	      return true;
+	    }
+	  else if (v[0] == '#' && delim == STYLE_II_COMMENT_SYMBOL)
+	    {
+	      *top = u;
+	      *ch = &v[1];
+	      return true;
+	    }
+	  else if (is_bold (v, "ETON") && delim == BOLD_COMMENT_BEGIN_SYMBOL)
+	    {
+	      gcc_assert (nesting_level > 0);
+	      nesting_level -= 1;
+	      if (nesting_level == 0)
+		{
+		  *top = u;
+		  *ch = &v[1];
+		  return true;
+		}
+	    }
+	  else if (v[0] == '}' && delim == BRIEF_COMMENT_BEGIN_SYMBOL)
+	    {
+	      gcc_assert (nesting_level > 0);
+	      nesting_level -= 1;
+	      if (nesting_level == 0)
+		{
+		  *top = u;
+		  *ch = &v[1];
+		  return true;
+		}
+	    }
+	  else
+	    {
+	      if ((is_bold (v, "NOTE") && delim == BOLD_COMMENT_BEGIN_SYMBOL)
+		  || (v[0] == '{' && delim == BRIEF_COMMENT_BEGIN_SYMBOL))
+		{
+		  nesting_level += 1;
+		}
+
+	      v++;
+	    }
+	}
+      FORWARD (u);
+      if (u != NO_LINE)
+	v = &(STRING (u)[0]);
+      else
+	v = NO_TEXT;
+    }
+
+  return false;
+}
+
+/* Skip rest of pragmat.
+
+   This function returns true if the end of the pragmat is found, false
+   otherwise.  */
+
+static bool
+skip_pragmat (LINE_T **top, char **ch, int delim, bool whitespace)
+{
+  LINE_T *u = *top;
+  char *v = *ch;
+  while (u != NO_LINE)
+    {
+      while (v[0] != NULL_CHAR)
+	{
+	  if (is_bold (v, "PRAGMAT") && delim == BOLD_PRAGMAT_SYMBOL)
+	    {
+	      *top = u;
+	      *ch = &v[1];
+	      return true;
+	    }
+	  else if (is_bold (v, "PR") && delim == STYLE_I_PRAGMAT_SYMBOL)
+	    {
+	      *top = u;
+	      *ch = &v[1];
+	      return true;
+	    }
+	  else
+	    {
+	      if (whitespace && !ISSPACE (v[0]) && v[0] != NEWLINE_CHAR)
+		{
+		  SCAN_ERROR (true, u, v, "error in pragment");
+		}
+	      else if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING && ISUPPER (v[0]))
+		{
+		  /* Skip a bold word as you may trigger on REPR, for
+		     instance.  */
+		  while (ISUPPER (v[0]))
+		    v++;
+		}
+	      else if (OPTION_STROPPING (&A68_JOB) == SUPPER_STROPPING && ISLOWER (v[0]))
+		{
+		  /* Skip a tag as you may trigger on expr, for instance.  */
+		  while (ISLOWER (v[0]) || ISDIGIT (v[0]) || v[0] == '_')
+		    v++;
+		}
+	      else
+		{
+		  v++;
+		}
+	    }
+	}
+
+      FORWARD (u);
+      if (u != NO_LINE)
+	v = &(STRING (u)[0]);
+      else
+	v = NO_TEXT;
+    }
+
+  return false;
+}
+
+/* Return pointer to next token within pragmat.  */
+
+static char *
+get_pragmat_item (LINE_T **top, char **ch)
+{
+  LINE_T *u = *top;
+  char *v = *ch;
+  while (u != NO_LINE)
+    {
+      while (v[0] != NULL_CHAR)
+	{
+	  if (!ISSPACE (v[0]) && v[0] != NEWLINE_CHAR)
+	    {
+	      *top = u;
+	      *ch = v;
+	      return v;
+	    }
+	  else
+	    {
+	      v++;
+	    }
+	}
+      FORWARD (u);
+      if (u != NO_LINE)
+	v = &(STRING (u)[0]);
+      else
+	v = NO_TEXT;
+  }
+
+  return NO_TEXT;
+}
+
+/* Scan for the next pragmat and yield the first item within it.  */
+
+static char *
+next_preprocessor_item (LINE_T **top, char **ch, int *delim)
+{
+  LINE_T *u = *top;
+  char *v = *ch;
+  *delim = 0;
+  while (u != NO_LINE)
+    {
+      while (v[0] != NULL_CHAR)
+	{
+	  LINE_T *start_l = u;
+	  char *start_c = v;
+
+	  if (v[0] == QUOTE_CHAR)
+	    {
+	      /* Skip string denotation.  */
+	      SCAN_ERROR (!skip_string (&u, &v), start_l, start_c,
+			  "unterminated string");
+	    }
+	  else if (a68_find_keyword (A68 (top_keyword), "COMMENT") != NO_KEYWORD
+		   && is_bold (v, "COMMENT"))
+	    {
+	      /* Skip comment.  */
+	      SCAN_ERROR (!skip_comment (&u, &v, BOLD_COMMENT_SYMBOL), start_l, start_c,
+			  "unterminated comment");
+	    }
+	  else if (a68_find_keyword (A68 (top_keyword), "CO") != NO_KEYWORD
+		   && is_bold (v, "CO"))
+	    {
+	      /* skip comment.  */
+	      SCAN_ERROR (!skip_comment (&u, &v, STYLE_I_COMMENT_SYMBOL), start_l, start_c,
+			  "unterminated comment");
+	    }
+	  else if (a68_find_keyword (A68 (top_keyword), "#") != NO_KEYWORD
+		   && v[0] == '#')
+	    {
+	      SCAN_ERROR (!skip_comment (&u, &v, STYLE_II_COMMENT_SYMBOL), start_l, start_c,
+			  "unterminated comment");
+	    }
+	  else if (a68_find_keyword (A68 (top_keyword), "NOTE") != NO_KEYWORD
+		   && is_bold (v, "NOTE"))
+	    {
+	      SCAN_ERROR (!skip_comment (&u, &v, BOLD_COMMENT_BEGIN_SYMBOL), start_l, start_c,
+			  "unterminated comment");
+	    }
+	  else if (a68_find_keyword (A68 (top_keyword), "{") != NO_KEYWORD
+		   && v[0] == '{')
+	    {
+	      SCAN_ERROR (!skip_comment (&u, &v, BRIEF_COMMENT_BEGIN_SYMBOL), start_l, start_c,
+			  "unterminated comment");
+	    }
+	  else if (is_bold (v, "PRAGMAT") || is_bold (v, "PR"))
+	    {
+	      /* We caught a PRAGMAT.  */
+	      char *item;
+	      if (is_bold (v, "PRAGMAT"))
+		{
+		  *delim = BOLD_PRAGMAT_SYMBOL;
+		  v = &v[strlen ("PRAGMAT")];
+		}
+	      else if (is_bold (v, "PR"))
+		{
+		  *delim = STYLE_I_PRAGMAT_SYMBOL;
+		  v = &v[strlen ("PR")];
+		}
+	      item = get_pragmat_item (&u, &v);
+	      SCAN_ERROR (item == NO_TEXT, start_l, start_c,
+			  "unterminated pragmat");
+
+	      if (streq (item, "INCLUDE") == 0)
+		{
+		  /* Item "INCLUDE" includes a file.  */
+		  *top = u;
+		  *ch = v;
+		  return item;
+		}
+	      else
+		{
+		  /* Unrecognised item - probably options handled later by the
+		     tokeniser.  */
+		  SCAN_ERROR (!skip_pragmat (&u, &v, *delim, false), start_l, start_c,
+			      "unterminated pragmat");
+		}
+	    }
+	  else if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING && ISUPPER (v[0]))
+	    {
+	      /* Skip a bold word as you may trigger on REPR, for instance.  */
+	      while (ISUPPER (v[0]))
+		v++;
+	    }
+	  else if (OPTION_STROPPING (&A68_JOB) == SUPPER_STROPPING && ISLOWER (v[0]))
+	    {
+	      /* Skip a tag as you may trigger on expr, for instance.  */
+	      while (ISLOWER (v[0]) || ISDIGIT (v[0]) || v[0] == '_')
+		v++;
+	    }
+	  else
+	    {
+	      v++;
+	    }
+	}
+
+      FORWARD (u);
+      if (u != NO_LINE)
+	v = &(STRING (u)[0]);
+      else
+	v = NO_TEXT;
+    }
+
+  *top = u;
+  *ch = v;
+  return NO_TEXT;
+}
+
+/* Concatenate the two paths P1 and P2.  */
+
+static char *
+a68_relpath (const char *p1, const char *p2, const char *fn)
+{
+#if defined(__GNU__)
+  /* The Hurd doesn't define PATH_MAX.  */
+# define PATH_MAX 4096
+#endif
+
+  char q[PATH_MAX + 1];
+  a68_bufcpy (q, p1, PATH_MAX);
+  a68_bufcat (q, "/", PATH_MAX);
+  a68_bufcat (q, p2, PATH_MAX);
+  a68_bufcat (q, "/", PATH_MAX);
+  a68_bufcat (q, fn, PATH_MAX);
+  /* Home directory shortcut ~ is a shell extension.  */
+  if (strchr (q, '~') != NO_TEXT) {
+    return NO_TEXT;
+  }
+  char *r = (char *) xmalloc (PATH_MAX + 1);
+  gcc_assert (r != NULL);
+  /*  Error handling in the caller!  */
+  errno = 0;
+  r = lrealpath (q);
+  return r;
+}
+
+/* Return true if we can open the file for reading.  False otherwise.  */
+
+static bool
+file_read_p (const char *filename)
+{
+  return access (filename, R_OK) == 0 ? true : false;
+}
+
+/* Find a file to include into the current source being parsed.  Search the file
+   system for FILENAME and return a string with the file path.  If the file is
+   not found, return NULL.
+
+   When FILENAME is not an absolute path we first try to find it relative to the
+   current file being parsed (CURFILE). Failing to do that we use the search
+   paths provided by the -I option.  */
+
+static char *
+find_include_file (const char *curfile, const char *filename)
+{
+  char *filepath = NO_TEXT;
+  char *tmpfpath = NO_TEXT;
+  char *fnbdir = ldirname (filename);
+  const char *incfile = lbasename (filename);
+
+  if (fnbdir == NULL || incfile == NULL)
+    gcc_unreachable ();
+
+  if (!IS_ABSOLUTE_PATH (filename))
+    {
+      char *sourcedir = ldirname (curfile);
+
+      if (sourcedir == NULL || fnbdir == NULL)
+	gcc_unreachable ();
+
+      if (strlen (sourcedir) == 0 && strlen (fnbdir) == 0)
+	{
+	  free (sourcedir);
+	  sourcedir = (char *) xmalloc (2);
+	  a68_bufcpy (sourcedir, ".", 2);
+	}
+
+      tmpfpath = a68_relpath (sourcedir, fnbdir, incfile);
+      if (file_read_p (tmpfpath))
+	{
+	  filepath = tmpfpath;
+	  goto cleanup;
+	}
+
+      for (unsigned ix = 0; ix != vec_safe_length (A68_INCLUDE_PATHS); ix++)
+	{
+	  const char *include_dir = (*(A68_INCLUDE_PATHS))[ix];
+	  tmpfpath = a68_relpath (include_dir, fnbdir, incfile);
+	  if (!IS_ABSOLUTE_PATH (tmpfpath))
+	    tmpfpath = a68_relpath (sourcedir, fnbdir, incfile);
+	  if (file_read_p (tmpfpath))
+	    {
+	      filepath = tmpfpath;
+	      goto cleanup;
+	    }
+	}
+
+    cleanup:
+      free (sourcedir);
+      goto end;
+    }
+  else
+    {
+      size_t fnwid = (int) strlen (filename) + 1;
+      tmpfpath = (char *) xmalloc ((size_t) fnwid);
+      a68_bufcpy (tmpfpath, filename, fnwid);
+
+      if (file_read_p (tmpfpath))
+	{
+	  filepath = tmpfpath;
+	  goto end;
+	}
+    }
+
+end:
+  free (fnbdir);
+  return filepath;
+}
+
+/* Include files.
+   This function handles the INCLUDE pragmat in the source file.  */
+
+static void
+include_files (LINE_T *top)
+{
+  /* syntax: PR include "filename" PR
+
+     The file gets inserted before the line containing the pragmat. In this way
+     correct line numbers are preserved which helps diagnostics. A file that
+     has been included will not be included a second time - it will be ignored.
+     A rigorous fail-safe, but there is no mechanism to prevent recursive
+     includes in A68 source code. User reports do not indicate sophisticated
+     use of INCLUDE, so this is fine for now.
+  */
+
+  bool make_pass = true;
+  while (make_pass)
+    {
+      LINE_T *s, *t, *u = top;
+      char *v = &(STRING (u)[0]);
+      make_pass = false;
+      errno = 0;
+      while (u != NO_LINE)
+	{
+	  int pr_lim;
+	  char *item = next_preprocessor_item (&u, &v, &pr_lim);
+	  LINE_T *start_l = u;
+	  char *start_c = v;
+	  /* Search for PR include "filename" PR.  */
+	  if (item != NO_TEXT && streq (item, "INCLUDE") == 0)
+	    {
+	      FILE *fp;
+	      int fd;
+	      size_t fsize, k;
+	      int n, linum, bytes_read;
+	      char *fbuf, delim;
+	      BUFFER fnb;
+	      char *fn = NO_TEXT;
+	      /* Skip to filename.  */
+	      while (ISALPHA (v[0]))
+		v++;
+	      while (ISSPACE (v[0]))
+		v++;
+	      /* Scan quoted filename.  */
+	      SCAN_ERROR ((v[0] != QUOTE_CHAR && v[0] != '\''), start_l, start_c,
+			  "incorrect filename");
+	      delim = (v++)[0];
+	      n = 0;
+	      fnb[0] = NULL_CHAR;
+	      /* Scan Algol 68 string (note: "" denotes a ", while in C it
+		 concatenates).  */
+	      do
+		{
+		  SCAN_ERROR (EOL (v[0]), start_l, start_c,
+			      "incorrect filename");
+		  SCAN_ERROR (n == BUFFER_SIZE - 1, start_l, start_c,
+			      "incorrect filename");
+		  if (v[0] == delim)
+		    {
+		      while (v[0] == delim && v[1] == delim)
+			{
+			  SCAN_ERROR (n == BUFFER_SIZE - 1, start_l, start_c,
+				      "incorrect filename");
+			  fnb[n++] = delim;
+			  fnb[n] = NULL_CHAR;
+			  v += 2;
+			}
+		    }
+		  else if (ISPRINT (v[0]))
+		    {
+		      fnb[n++] = *(v++);
+		      fnb[n] = NULL_CHAR;
+		    }
+		  else
+		    {
+		      SCAN_ERROR (true, start_l, start_c,
+				  "incorrect filename");
+		    }
+		}
+	      while (v[0] != delim);
+
+	      /* Insist that the pragmat is closed properly.  */
+	      v = &v[1];
+	      SCAN_ERROR (!skip_pragmat (&u, &v, pr_lim, true), start_l, start_c,
+			  "unterminated pragmat");
+	      SCAN_ERROR (n == 0, start_l, start_c,
+			  "incorrect filename");
+
+	      char *sourcefile = NO_TEXT;
+	      if (FILENAME (u) != NO_TEXT)
+		{
+		  sourcefile = xstrdup (FILENAME (u));
+		}
+	      else
+		{
+		  sourcefile = (char *) xmalloc (2);
+		  a68_bufcpy (sourcefile, ".", 1);
+		}
+	      fn = find_include_file (sourcefile, fnb);
+	      free (sourcefile);
+
+	      /* Do not check errno, since errno may be undefined here
+		 after a successful call.  */
+	      if (fn != NO_TEXT)
+		a68_bufcpy (fnb, fn, BUFFER_SIZE);
+	      else
+		{
+		  SCAN_ERROR (true, start_l, start_c,
+			      "included file not found");
+		}
+	      size_t fnwid = (int) strlen (fnb) + 1;
+	      fn = (char *) xmalloc ((size_t) fnwid);
+	      a68_bufcpy (fn, fnb, fnwid);
+
+	      /* Ignore the file when included more than once.  */
+	      for (t = top; t != NO_LINE; t = NEXT (t))
+		{
+		  if (strcmp (FILENAME (t), fn) == 0)
+		    goto search_next_pragmat;
+		}
+	      t = NO_LINE;
+
+	      /* Access the file.  */
+	      errno = 0;
+	      fp = fopen (fn, "r");
+	      SCAN_ERROR (fp == NULL, start_l, start_c,
+			  "error opening included file");
+	      fd = fileno (fp);
+	      errno = 0;
+	      off_t off = lseek (fd, 0, SEEK_END);
+	      gcc_assert (off >= 0);
+	      fsize = (size_t) off;
+	      SCAN_ERROR (errno != 0, start_l, start_c,
+			  "error while reading file");
+	      fbuf = (char *) xmalloc (8 + fsize);
+	      errno = 0;
+	      if (lseek (fd, 0, SEEK_SET) < 0)
+		gcc_unreachable ();
+	      SCAN_ERROR (errno != 0, start_l, start_c,
+			  "error while reading file");
+	      errno = 0;
+	      bytes_read = (int) io_read (fp, fbuf, (size_t) fsize);
+	      SCAN_ERROR (errno != 0 || (size_t) bytes_read != fsize, start_l, start_c,
+			  "error while reading file");
+
+	      /* Buffer still usable?.  */
+	      if (fsize > A68_PARSER (max_scan_buf_length))
+		{
+		  A68_PARSER (max_scan_buf_length) = fsize;
+		  A68_PARSER (scan_buf) = (char *) xmalloc (8 + A68_PARSER (max_scan_buf_length));
+		}
+
+	      /* Link all lines into the list.  */
+	      linum = 1;
+	      s = u;
+	      t = PREVIOUS (u);
+	      k = 0;
+	      if (fsize == 0)
+		{
+		  /* If file is empty, insert single empty line.  */
+		  A68_PARSER (scan_buf)[0] = NEWLINE_CHAR;
+		  A68_PARSER (scan_buf)[1] = NULL_CHAR;
+		  append_source_line (A68_PARSER (scan_buf), &t, &linum, fn);
+		}
+	      else
+		{
+		  while (k < fsize)
+		    {
+		      n = 0;
+		      A68_PARSER (scan_buf)[0] = NULL_CHAR;
+		      while (k < fsize && fbuf[k] != NEWLINE_CHAR)
+			{
+			  SCAN_ERROR ((ISCNTRL (fbuf[k]) && !ISSPACE (fbuf[k]))
+				      || fbuf[k] == STOP_CHAR,
+				      start_l, start_c,
+				      "invalid characters in included file");
+			  A68_PARSER (scan_buf)[n++] = fbuf[k++];
+			  A68_PARSER (scan_buf)[n] = NULL_CHAR;
+			}
+		      A68_PARSER (scan_buf)[n++] = NEWLINE_CHAR;
+		      A68_PARSER (scan_buf)[n] = NULL_CHAR;
+		      if (k < fsize)
+			k++;
+		      append_source_line (A68_PARSER (scan_buf), &t, &linum, fn);
+		    }
+		}
+
+	      /* Conclude and go find another include directive, if any.  */
+	      NEXT (t) = s;
+	      PREVIOUS (s) = t;
+	      concatenate_lines (top);
+	      if (fclose (fp) != 0)
+		gcc_unreachable ();
+	      make_pass = true;
+	    }
+	search_next_pragmat:
+	  { (void) 0; };
+	}
+    }
+}
+
+/* Handle a pragment (pragmat or comment).  */
+
+static char *
+pragment (int type, LINE_T **ref_l, char **ref_c)
+{
+#define INIT_BUFFER					\
+  do							\
+    {							\
+      chars_in_buf = 0;					\
+      A68_PARSER (scan_buf)[chars_in_buf] = '\0';	\
+    }							\
+  while (0)
+
+#define ADD_ONE_CHAR(CH)						\
+  do									\
+    {									\
+      A68_PARSER (scan_buf)[chars_in_buf ++] = (CH);			\
+      A68_PARSER (scan_buf)[chars_in_buf] = '\0';			\
+    }									\
+  while (0)
+
+  const char *term_s = NO_TEXT;
+  const char *beg_s = NO_TEXT;
+  char c = **ref_c, *start_c = *ref_c;
+  char *z = NO_TEXT;
+  LINE_T *start_l = *ref_l;
+  int beg_s_length, term_s_length, chars_in_buf;
+  bool stop, pragmat = false;
+
+  /* Set terminator to look for.  */
+  if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING)
+    {
+      if (type == STYLE_I_COMMENT_SYMBOL)
+	term_s = "CO";
+      else if (type == STYLE_II_COMMENT_SYMBOL)
+	term_s = "#";
+      else if (type == BOLD_COMMENT_SYMBOL)
+	term_s = "COMMENT";
+      else if (type == BOLD_COMMENT_BEGIN_SYMBOL)
+	{
+	  beg_s = "NOTE";
+	  term_s = "ETON";
+	}
+      else if (type == BRIEF_COMMENT_BEGIN_SYMBOL)
+	{
+	  beg_s = "{";
+	  term_s = "}";
+	}
+      else if (type == STYLE_I_PRAGMAT_SYMBOL)
+	{
+	  term_s = "PR";
+	  pragmat = true;
+	}
+      else if (type == BOLD_PRAGMAT_SYMBOL)
+	{
+	  term_s = "PRAGMAT";
+	  pragmat = true;
+	}
+    }
+  else
+    {
+      /* SUPPER stropping.  */
+      if (type == STYLE_I_COMMENT_SYMBOL)
+	term_s = "co";
+      else if (type == STYLE_II_COMMENT_SYMBOL)
+	term_s = "#";
+      else if (type == BOLD_COMMENT_SYMBOL)
+	term_s = "comment";
+      else if (type == BOLD_COMMENT_BEGIN_SYMBOL)
+	{
+	  beg_s = "note";
+	  term_s = "eton";
+	}
+      else if (type == BRIEF_COMMENT_BEGIN_SYMBOL)
+	{
+	  beg_s = "{";
+	  term_s = "}";
+	}
+      else if (type == STYLE_I_PRAGMAT_SYMBOL)
+	{
+	  term_s = "pr";
+	  pragmat = true;
+	}
+      else if (type == BOLD_PRAGMAT_SYMBOL)
+	{
+	  term_s = "pragmat";
+	  pragmat = true;
+	}
+    }
+
+  beg_s_length = (beg_s != NO_TEXT ? (int) strlen (beg_s) : 0);
+  term_s_length = (int) strlen (term_s);
+
+  /* Scan for terminator.  */
+  bool nestable_comment = (beg_s != NO_TEXT);
+  int nesting_level = 1;
+  INIT_BUFFER;
+  stop = false;
+  while (stop == false)
+    {
+      SCAN_ERROR (c == STOP_CHAR, start_l, start_c,
+		  "unterminated pragment");
+
+      /* A ".." or '..' delimited string in a PRAGMAT, or
+	 a ".." in a nestable comment.  */
+      if ((pragmat && (c == QUOTE_CHAR || c == '\''))
+	  || (nestable_comment && c == QUOTE_CHAR))
+	{
+	  char delim = c;
+	  bool eos = false;
+	  ADD_ONE_CHAR (c);
+	  c = next_char (ref_l, ref_c, false);
+	  while (!eos)
+	    {
+	      SCAN_ERROR (EOL (c), start_l, start_c,
+			  "string within pragment exceeds end of line");
+
+	      if (c == delim)
+		{
+		  ADD_ONE_CHAR (delim);
+		  save_state (*ref_l, *ref_c, c);
+		  c = next_char (ref_l, ref_c, false);
+		  if (c == delim)
+		    c = next_char (ref_l, ref_c, false);
+		  else
+		    {
+		      restore_state (ref_l, ref_c, &c);
+		      eos = true;
+		    }
+		}
+	      else if (ISPRINT (c))
+		{
+		  ADD_ONE_CHAR (c);
+		  c = next_char (ref_l, ref_c, false);
+		}
+	      else
+		unworthy (start_l, start_c, c);
+	    }
+	}
+      else if (EOL (c))
+	ADD_ONE_CHAR (NEWLINE_CHAR);
+      else if (ISPRINT (c) || ISSPACE (c))
+	ADD_ONE_CHAR (c);
+
+      if (nestable_comment && chars_in_buf >= beg_s_length)
+	{
+	  /* If we find another instance of the nestable begin mark, bump the
+	     nesting level and continue scanning.  */
+	  if (strcmp (beg_s,
+		      &(A68_PARSER (scan_buf)[chars_in_buf - beg_s_length])) == 0)
+	    {
+	      nesting_level += 1;
+	      goto nextchar;
+	    }
+	}
+
+      if (chars_in_buf >= term_s_length)
+	{
+	  /* Check whether we encountered the terminator.  Mind nesting if
+	     necessary.  */
+	  if (strcmp (term_s,
+		      &(A68_PARSER (scan_buf)[chars_in_buf - term_s_length])) == 0)
+	    {
+	      if (nestable_comment)
+		{
+		  gcc_assert (nesting_level > 0);
+		  nesting_level -= 1;
+		  stop = (nesting_level == 0);
+		}
+	      else
+		stop = true;
+	    }
+	}
+
+    nextchar:
+      c = next_char (ref_l, ref_c, false);
+    }
+
+  A68_PARSER (scan_buf)[chars_in_buf - term_s_length] = '\0';
+  z = a68_new_string (term_s, A68_PARSER (scan_buf), term_s, NO_TEXT);
+  return z;
+#undef ADD_ONE_CHAR
+#undef INIT_BUFFER
+}
+
+/* Whether input shows exponent character.  */
+
+static bool
+is_exp_char (LINE_T **ref_l, char **ref_s, char *ch)
+{
+  bool ret = false;
+
+  char exp_syms[3];
+
+  /* Note that this works for both UPPER and SUPPER stropping regimes.  */
+  exp_syms[0] = EXPONENT_CHAR;
+  exp_syms[1] = TOUPPER (EXPONENT_CHAR);
+  exp_syms[2] = '\0';
+
+  save_state (*ref_l, *ref_s, *ch);
+  if (strchr (exp_syms, *ch) != NO_TEXT)
+    {
+      *ch = next_char (ref_l, ref_s, true);
+      ret = (strchr ("+-0123456789", *ch) != NO_TEXT);
+    }
+  restore_state (ref_l, ref_s, ch);
+  return ret;
+}
+
+/* Whether input shows radix character.  */
+
+static bool
+is_radix_char (LINE_T **ref_l, char **ref_s, char *ch)
+{
+  bool ret = false;
+
+  save_state (*ref_l, *ref_s, *ch);
+  /* Note that this works for both UPPER and SUPPER stropping regimes.  */
+  if (*ch == RADIX_CHAR)
+    {
+      *ch = next_char (ref_l, ref_s, true);
+      ret = (strchr ("0123456789abcdef", *ch) != NO_TEXT);
+    }
+  restore_state (ref_l, ref_s, ch);
+  return ret;
+}
+
+/* Whether input shows decimal point.  */
+
+static bool
+is_decimal_point (LINE_T **ref_l, char **ref_s, char *ch)
+{
+  bool ret = false;
+
+  save_state (*ref_l, *ref_s, *ch);
+  if (*ch == POINT_CHAR)
+    {
+      char exp_syms[3];
+
+      /* Note that this works for both UPPER and SUPPER stropping regimes.  */
+      exp_syms[0] = EXPONENT_CHAR;
+      exp_syms[1] = TOUPPER (EXPONENT_CHAR);
+      exp_syms[2] = '\0';
+
+      *ch = next_char (ref_l, ref_s, true);
+      if (strchr (exp_syms, *ch) != NO_TEXT)
+	{
+	  *ch = next_char (ref_l, ref_s, true);
+	  ret = (strchr ("+-0123456789", *ch) != NO_TEXT);
+	}
+      else
+	ret = (strchr ("0123456789", *ch) != NO_TEXT);
+    }
+  restore_state (ref_l, ref_s, ch);
+  return ret;
+}
+
+/* Attribute for format item.  */
+
+static enum a68_attribute
+get_format_item (char ch)
+{
+  switch (TOLOWER (ch))
+    {
+    case 'a':
+      return FORMAT_ITEM_A;
+    case 'b':
+      return FORMAT_ITEM_B;
+    case 'c':
+      return FORMAT_ITEM_C;
+    case 'd':
+      return FORMAT_ITEM_D;
+    case 'e':
+      return FORMAT_ITEM_E;
+    case 'f':
+      return FORMAT_ITEM_F;
+    case 'g':
+      return FORMAT_ITEM_G;
+    case 'h':
+      return FORMAT_ITEM_H;
+    case 'i':
+      return FORMAT_ITEM_I;
+    case 'j':
+      return FORMAT_ITEM_J;
+    case 'k':
+      return FORMAT_ITEM_K;
+    case 'l':
+    case '/':
+      return FORMAT_ITEM_L;
+    case 'm':
+      return FORMAT_ITEM_M;
+    case 'n':
+      return FORMAT_ITEM_N;
+    case 'o':
+      return FORMAT_ITEM_O;
+    case 'p':
+      return FORMAT_ITEM_P;
+    case 'q':
+      return FORMAT_ITEM_Q;
+    case 'r':
+      return FORMAT_ITEM_R;
+    case 's':
+      return FORMAT_ITEM_S;
+    case 't':
+      return FORMAT_ITEM_T;
+    case 'u':
+      return FORMAT_ITEM_U;
+    case 'v':
+      return FORMAT_ITEM_V;
+    case 'w':
+      return FORMAT_ITEM_W;
+    case 'x':
+      return FORMAT_ITEM_X;
+    case 'y':
+      return FORMAT_ITEM_Y;
+    case 'z':
+      return FORMAT_ITEM_Z;
+    case '+':
+      return FORMAT_ITEM_PLUS;
+    case '-':
+      return FORMAT_ITEM_MINUS;
+    case POINT_CHAR:
+      return FORMAT_ITEM_POINT;
+    case '%':
+      return FORMAT_ITEM_ESCAPE;
+    default:
+      return STOP;
+    }
+}
+
+/* Get next token from internal copy of source file.
+
+   The kind of token is set via the passed pointer ATTR.
+   The contents of token is set in the scan_buf via SYM.
+
+   The recognized tokens are, by reported ATTR:
+
+   <unset>
+     End of file.
+   FORMAT_ITEM_*
+     Item in a format.
+   STATIC_REPLICATOR
+     INT denotation for a static replicator in a format.
+   BOLD_TAG
+     Bold tag.
+   IDENTIFIER
+     A "lower case" identifier.
+   IDENTIFIER_WITH_UNDERSCORES
+     A "lower case" identifier whose's at least one taggle
+     was found adjacent to an underscore.
+   REAL_DENOTATION
+     A REAL denotation.
+   POINT_SYMBOL
+     .
+   BITS_DENOTATION
+     A BITS denotation like 16rffff
+   INT_DENOTATION
+     An INT denotation.
+   ROW_CHAR_DENOTATION
+     A STRING denotation.
+   LITERAL
+     A literal denotation in a format.
+   STOP
+     Single-character symbols #$()[]{},;@|:
+     := /= :=: :/=:
+     The character is placed in SYM.
+   EQUALS_SYMBOL
+     The equality symbol.
+   OPERATOR
+     A predefined operator.
+*/
+
+static void
+get_next_token (bool in_format,
+		LINE_T **ref_l, char **ref_s,
+		LINE_T **start_l, char **start_c, enum a68_attribute *att)
+{
+  char c = **ref_s;
+  char *sym = A68_PARSER (scan_buf);
+
+  sym[0] = '\0';
+  get_good_char (&c, ref_l, ref_s);
+  *start_l = *ref_l;
+  *start_c = *ref_s;
+  if (c == STOP_CHAR)
+    {
+      /* We are at EOF.  */
+      (sym++)[0] = STOP_CHAR;
+      sym[0] = '\0';
+      return;
+    }
+
+  if (in_format)
+    {
+      /* In a format.  */
+      const char *format_items = "/%\\+-.abcdefghijklmnopqrstuvwxyz";
+      if (strchr (format_items, c) != NO_TEXT)
+	{
+	  /* General format items.  */
+	  (sym++)[0] = c;
+	  sym[0] = NULL_CHAR;
+	  *att = get_format_item (c);
+	  (void) next_char (ref_l, ref_s, false);
+	  return;
+	}
+      if (ISDIGIT (c))
+	{
+	  /* INT denotation for static replicator.  */
+	  SCAN_DIGITS (c);
+	  sym[0] = NULL_CHAR;
+	  *att = STATIC_REPLICATOR;
+	  return;
+	}
+    }
+
+  if (ISUPPER (c))
+    {
+      /* Bold taggles are enabled only in gnu68.  */
+      bool allow_one_under = !OPTION_STRICT (&A68_JOB);
+
+      if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING)
+	{
+	  /* In UPPER stropping a bold tag is an upper case word.  */
+	  while (ISUPPER (c))
+	    {
+	      (sym++)[0] = c;
+	      c = next_char (ref_l, ref_s, false, allow_one_under);
+	    }
+	  sym[0] = '\0';
+	  *att = BOLD_TAG;
+	}
+      else
+	{
+	  /* In SUPPER stropping a bold tag is a capitalized word that may
+	     contain letters and digits.  */
+	  while (ISALPHA (c) || ISDIGIT (c))
+	    {
+	      (sym++)[0] = c;
+	      c = next_char (ref_l, ref_s, false, allow_one_under);
+	    }
+	  sym[0] = '\0';
+	  *att = BOLD_TAG;
+	}
+    }
+  else if (ISLOWER (c))
+    {
+      /* In both UPPER and SUPPER stropping regimes a tag is a lower case word
+	 which may contain letters and digits.
+
+	 In SUPPER stropping, however, it is not allowed to have blanks
+	 separating the taggles within tags.  */
+
+      bool allow_one_under = true;
+      bool found_under = false;
+      bool allow_typo = OPTION_STROPPING (&A68_JOB) != SUPPER_STROPPING;
+
+      /* Lower case word - identifier.  */
+      while (ISLOWER (c) || ISDIGIT (c))
+	{
+	  (sym++)[0] = c;
+	  c = next_char (ref_l, ref_s, allow_typo, allow_one_under,
+			 &found_under);
+	}
+
+      sym[0] = '\0';
+      *att = found_under ? IDENTIFIER_WITH_UNDERSCORES : IDENTIFIER;
+    }
+  else if (c == POINT_CHAR)
+    {
+      /* Begins with a point symbol - point, L REAL denotation.  */
+      if (is_decimal_point (ref_l, ref_s, &c))
+	{
+	  (sym++)[0] = '0';
+	  (sym++)[0] = POINT_CHAR;
+	  c = next_char (ref_l, ref_s, true);
+	  SCAN_DIGITS (c);
+	  if (is_exp_char (ref_l, ref_s, &c))
+	    SCAN_EXPONENT_PART (c);
+	  sym[0] = '\0';
+	  *att = REAL_DENOTATION;
+	}
+      else
+	{
+	  c = next_char (ref_l, ref_s, true);
+	  (sym++)[0] = POINT_CHAR;
+	  sym[0] = '\0';
+	  *att = POINT_SYMBOL;
+	}
+    }
+  else if (ISDIGIT (c))
+    {
+      /* Something that begins with a digit:
+	 L INT denotation, L REAL denotation.  */
+      SCAN_DIGITS (c);
+
+      if (is_decimal_point (ref_l, ref_s, &c))
+	{
+	  c = next_char (ref_l, ref_s, true);
+	  if (is_exp_char (ref_l, ref_s, &c))
+	    {
+	      (sym++)[0] = POINT_CHAR;
+	      (sym++)[0] = '0';
+	      SCAN_EXPONENT_PART (c);
+	      *att = REAL_DENOTATION;
+	    }
+	  else
+	    {
+	      (sym++)[0] = POINT_CHAR;
+	      SCAN_DIGITS (c);
+	      if (is_exp_char (ref_l, ref_s, &c))
+		SCAN_EXPONENT_PART (c);
+	      *att = REAL_DENOTATION;
+	    }
+	}
+      else if (is_exp_char (ref_l, ref_s, &c))
+	{
+	  SCAN_EXPONENT_PART (c);
+	  *att = REAL_DENOTATION;
+	}
+      else if (is_radix_char (ref_l, ref_s, &c))
+	{
+	  (sym++)[0] = c;
+	  c = next_char (ref_l, ref_s, true);
+	  /* This is valid for both UPPER and SUPPER stropping.  */
+	  while (ISDIGIT (c) || strchr ("abcdef", c) != NO_TEXT)
+	    {
+	      (sym++)[0] = c;
+	      c = next_char (ref_l, ref_s, true);
+	    }
+	  *att = BITS_DENOTATION;
+	}
+      else
+	{
+	  *att = INT_DENOTATION;
+	}
+      sym[0] = '\0';
+    }
+  else if (c == QUOTE_CHAR)
+    {
+      /* STRING denotation.  */
+      bool stop = false;
+
+      while (!stop)
+	{
+	  c = next_char (ref_l, ref_s, false);
+	  while (c != QUOTE_CHAR && c != STOP_CHAR)
+	    {
+	      if (c == APOSTROPHE_CHAR)
+		{
+		  (sym++)[0] = c;
+		  c = next_char (ref_l, ref_s, false);
+		  switch (c)
+		    {
+		    case APOSTROPHE_CHAR:
+		    case 'n':
+		    case 'f':
+		    case 'r':
+		    case 't':
+		      (sym++)[0] = c;
+		      break;
+		    case '(':
+		      {
+			unsigned int num_code_points = 0;
+
+			(sym++)[0] = c;
+			/* Process code points.  */
+			while (1)
+			  {
+			    /* Skip white spaces.  */
+			    while (1)
+			      {
+				c = next_char (ref_l, ref_s, false);
+				if (!ISSPACE (c))
+				  break;
+			      }
+
+			    /* See if we are done.  */
+			    if (c == ')')
+			      {
+				SCAN_ERROR (num_code_points == 0, *start_l, *ref_s,
+					    "expected at least one character point in string break");
+				(sym++)[0] = c;
+				break;
+			      }
+			    else if (c == 'u' || c == 'U')
+			      {
+				(sym++)[0] = c;
+				/* Process a code point.  */
+				char u = c;
+				int numdigits = (u == 'u' ? 4 : 8);
+				char *startpos = *ref_s;
+				int i = 0;
+				do
+				  {
+				    c = next_char (ref_l, ref_s, false);
+				    if (!(ISDIGIT (c)
+					  || ((c >= 'a') && (c <= 'f'))
+					  || ((c >= 'A') && (c <= 'F'))))
+				      {
+					SCAN_ERROR (true, *start_l, startpos,
+						    (u == 'u'
+						     ? "expected four hex digits in \
+string break character point"
+						     : "expected eight hex digits in \
+string break character point"));
+				      }
+				    (sym++)[0] = c;
+				    i += 1;
+				  }
+				while (i < numdigits);
+
+				/* Skip white spaces.  */
+				while (1)
+				  {
+				    c = next_char (ref_l, ref_s, false);
+				    if (!ISSPACE (c))
+				      break;
+				  }
+
+				/* Comma or end of list.  */
+				if (c == ')')
+				  {
+				    (sym++)[0] = c;
+				    break;
+				  }
+
+				SCAN_ERROR (c != ',', *start_l, *ref_s,
+					    "expected , or ) in string break");
+			      }
+			    else
+			      {
+				SCAN_ERROR (true, *start_l, *ref_s,
+					    "unterminated list of character codes");
+			      }
+			  }
+			break;
+		      }
+		    default:
+		      SCAN_ERROR (true, *start_l, *ref_s, "invalid string break sequence");
+		    }
+		}
+	      else
+		{
+		  SCAN_ERROR (EOL (c), *start_l, *start_c, "string exceeds end of line");
+		  (sym++)[0] = c;
+		}
+	      c = next_char (ref_l, ref_s, false);
+	    }
+	  SCAN_ERROR (*ref_l == NO_LINE, *start_l, *start_c, "unterminated string");
+	  c = next_char (ref_l, ref_s, false);
+	  if (c == QUOTE_CHAR)
+	    (sym++)[0] = QUOTE_CHAR;
+	  else
+	    stop = true;
+	}
+      sym[0] = '\0';
+      *att = (in_format ? LITERAL : ROW_CHAR_DENOTATION);
+    }
+  else if (strchr ("#$()[]{},;@", c) != NO_TEXT)
+    {
+      /* Single character symbols.  */
+      (sym++)[0] = c;
+      (void) next_char (ref_l, ref_s, false);
+      sym[0] = '\0';
+      *att = STOP;
+    }
+  else if (c == '|')
+    {
+      /* Bar.  */
+      (sym++)[0] = c;
+      c = next_char (ref_l, ref_s, false);
+      if (c == ':')
+	{
+	  (sym++)[0] = c;
+	  (void) next_char (ref_l, ref_s, false);
+	}
+      sym[0] = '\0';
+      *att = STOP;
+    }
+  else if (c == ':')
+    {
+      /* Colon, semicolon, IS, ISNT.  */
+      (sym++)[0] = c;
+      c = next_char (ref_l, ref_s, false);
+      if (c == '=')
+	{
+	  (sym++)[0] = c;
+	  if ((c = next_char (ref_l, ref_s, false)) == ':')
+	    {
+	      (sym++)[0] = c;
+	      c = next_char (ref_l, ref_s, false);
+	    }
+	}
+      else if (c == '/')
+	{
+	  (sym++)[0] = c;
+	  if ((c = next_char (ref_l, ref_s, false)) == '=')
+	    {
+	      (sym++)[0] = c;
+	      if ((c = next_char (ref_l, ref_s, false)) == ':')
+		{
+		  (sym++)[0] = c;
+		  c = next_char (ref_l, ref_s, false);
+		}
+	    }
+	}
+      else if (c == ':')
+	{
+	  (sym++)[0] = c;
+	  if ((c = next_char (ref_l, ref_s, false)) == '=')
+	    (sym++)[0] = c;
+	}
+
+      sym[0] = '\0';
+      *att = STOP;
+
+    }
+  else if (c == '=')
+    {
+      /* Operator starting with "=".  */
+      char *scanned = sym;
+      (sym++)[0] = c;
+      c = next_char (ref_l, ref_s, false);
+      if (strchr (NOMADS, c) != NO_TEXT)
+	{
+	  (sym++)[0] = c;
+	  c = next_char (ref_l, ref_s, false);
+	}
+      if (c == '=')
+	{
+	  (sym++)[0] = c;
+	  if (next_char (ref_l, ref_s, false) == ':')
+	    {
+	      (sym++)[0] = ':';
+	      c = next_char (ref_l, ref_s, false);
+	      if (strlen (sym) < 4 && c == '=')
+		{
+		  (sym++)[0] = '=';
+		  (void) next_char (ref_l, ref_s, false);
+		}
+	    }
+	}
+      else if (c == ':')
+	{
+	  (sym++)[0] = c;
+	  sym[0] = '\0';
+	  if (next_char (ref_l, ref_s, false) == '=')
+	    {
+	      (sym++)[0] = '=';
+	      (void) next_char (ref_l, ref_s, false);
+	    }
+	  else
+	    {
+	      SCAN_ERROR (!(strcmp (scanned, "=:") == 0 || strcmp (scanned, "==:") == 0),
+			  *start_l, *start_c, "invalid operator tag");
+	    }
+	}
+      sym[0] = '\0';
+      if (strcmp (scanned, "=") == 0)
+	*att = EQUALS_SYMBOL;
+      else
+	*att = OPERATOR;
+    }
+  else if (strchr (MONADS, c) != NO_TEXT || strchr (NOMADS, c) != NO_TEXT)
+    {
+      /* Operator.  */
+      char *scanned = sym;
+      (sym++)[0] = c;
+      c = next_char (ref_l, ref_s, false);
+      if (strchr (NOMADS, c) != NO_TEXT)
+	{
+	  (sym++)[0] = c;
+	  c = next_char (ref_l, ref_s, false);
+	}
+      if (c == '=')
+	{
+	  (sym++)[0] = c;
+	  if (next_char (ref_l, ref_s, false) == ':')
+	    {
+	      (sym++)[0] = ':';
+	      c = next_char (ref_l, ref_s, false);
+	      if (strlen (scanned) < 4 && c == '=')
+		{
+		  (sym++)[0] = '=';
+		  (void) next_char (ref_l, ref_s, false);
+		}
+	    }
+	}
+      else if (c == ':')
+	{
+	  (sym++)[0] = c;
+	  sym[0] = '\0';
+	  if (next_char (ref_l, ref_s, false) == '=')
+	    {
+	      (sym++)[0] = '=';
+	      sym[0] = '\0';
+	      (void) next_char (ref_l, ref_s, false);
+	    }
+	  else
+	    {
+	      SCAN_ERROR (strcmp (&(scanned[1]), "=:") != 0,
+			  *start_l, *start_c, "invalid operator tag");
+	    }
+	}
+      sym[0] = '\0';
+      *att = OPERATOR;
+    }
+  else
+    {
+      /* Afuuus ... strange characters!.  */
+      unworthy (*start_l, *start_c, (int) c);
+    }
+}
+
+/* Whether att opens an embedded clause.  */
+
+static bool
+open_nested_clause (int att)
+{
+  switch (att)
+    {
+    case OPEN_SYMBOL:
+    case BEGIN_SYMBOL:
+    case PAR_SYMBOL:
+    case IF_SYMBOL:
+    case CASE_SYMBOL:
+    case FOR_SYMBOL:
+    case FROM_SYMBOL:
+    case BY_SYMBOL:
+    case TO_SYMBOL:
+    case WHILE_SYMBOL:
+    case DO_SYMBOL:
+    case SUB_SYMBOL:
+      return true;
+    }
+  return false;
+}
+
+/* Whether att closes an embedded clause.  */
+
+static bool
+close_nested_clause (int att)
+{
+  switch (att)
+    {
+    case CLOSE_SYMBOL:
+    case END_SYMBOL:
+    case FI_SYMBOL:
+    case ESAC_SYMBOL:
+    case OD_SYMBOL:
+    case BUS_SYMBOL:
+      return true;
+    }
+  return false;
+}
+
+/* Cast a string to lower case.  */
+
+static void
+make_lower_case (char *p)
+{
+  for (; p != NO_TEXT && p[0] != '\0'; p++)
+    p[0] = TOLOWER (p[0]);
+}
+
+/* Cast a string to upper case.  */
+
+static void
+make_upper_case (char *p)
+{
+  for (; p != NO_TEXT && p[0] != '\0'; p++)
+    p[0] = TOUPPER (p[0]);
+}
+
+/* Construct a linear list of tokens.  */
+
+static void
+tokenise_source (NODE_T **root, int level, bool in_format,
+		 LINE_T **l, char **s, LINE_T **start_l,
+		 char **start_c)
+{
+  char *lpr = NO_TEXT;
+  int lprt = 0;
+
+  while (l != NO_VAR && !A68_PARSER (stop_scanner))
+    {
+      enum a68_attribute att = STOP;
+      get_next_token (in_format, l, s, start_l, start_c, &att);
+
+      if (A68_PARSER (scan_buf)[0] == STOP_CHAR)
+	A68_PARSER (stop_scanner) = true;
+      else if (strlen (A68_PARSER (scan_buf)) > 0 || att == ROW_CHAR_DENOTATION || att == LITERAL)
+	{
+	  KEYWORD_T *kw;
+	  const char *c = NO_TEXT;
+	  bool make_node = true;
+	  const char *trailing = NO_TEXT;
+
+	  if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING)
+	    {
+	      /* In UPPER stropping all symbols in R9.4.1 are expressed as bold
+		 tags like "BEGIN", or symbols like "@".  */
+
+	      /* In this stropping regime there is no need to handle
+		 identifiers for which taggles were adjacent to underscores
+		 specially.  */
+	      if (att != IDENTIFIER && att != IDENTIFIER_WITH_UNDERSCORES)
+		kw = a68_find_keyword (A68 (top_keyword), A68_PARSER (scan_buf));
+	      else
+		kw = NO_KEYWORD;
+	    }
+	  else
+	    {
+	      /* In SUPPER stropping all symbols in R9.4.1 are expressed as
+		 tags like "begin", or symbols like "@".  */
+
+	      /* Normalize bold tags to all upper-case letters.  */
+	      if (att == BOLD_TAG)
+		make_upper_case (A68_PARSER (scan_buf));
+
+	      /* If any of the taggles of the scanned identifier were adjacent
+		 to an underscore, that inhibits interpreting it as a
+		 keyword.  */
+	      if (att != BOLD_TAG && att != IDENTIFIER_WITH_UNDERSCORES)
+		kw = a68_find_keyword (A68 (top_keyword), A68_PARSER (scan_buf));
+	      else
+		kw = NO_KEYWORD;
+	    }
+
+	  /* Beyond this point it is irrelevant whether an identifier had
+	     taggles adjacent to an underscore.  */
+	  if (att == IDENTIFIER_WITH_UNDERSCORES)
+	    att = IDENTIFIER;
+
+	  if (kw == NO_KEYWORD || att == ROW_CHAR_DENOTATION)
+	    {
+	      if (att == IDENTIFIER)
+		make_lower_case (A68_PARSER (scan_buf));
+	      if (att != ROW_CHAR_DENOTATION && att != LITERAL)
+		{
+		  size_t len = strlen (A68_PARSER (scan_buf));
+		  while (len >= 1 && A68_PARSER (scan_buf)[len - 1] == '_')
+		    {
+		      trailing = "_";
+		      A68_PARSER (scan_buf)[len - 1] = NULL_CHAR;
+		      len--;
+		    }
+		}
+	      c = TEXT (a68_add_token (&A68 (top_token), A68_PARSER (scan_buf)));
+	    }
+	  else
+	    {
+	      if (IS (kw, TO_SYMBOL))
+		{
+		  /* Merge GO and TO to GOTO.  */
+		  if (*root != NO_NODE && IS (*root, GO_SYMBOL))
+		    {
+		      ATTRIBUTE (*root) = GOTO_SYMBOL;
+		      NSYMBOL (*root) = TEXT (a68_find_keyword (A68 (top_keyword), "GOTO"));
+		      make_node = false;
+		    }
+		  else
+		    {
+		      att = ATTRIBUTE (kw);
+		      c = TEXT (kw);
+		    }
+		}
+	      else
+		{
+		  if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING)
+		    {
+		      if (att == 0 || att == BOLD_TAG)
+			att = ATTRIBUTE (kw);
+		    }
+		  else
+		    {
+		      if (att == 0 || att == IDENTIFIER)
+			att = ATTRIBUTE (kw);
+		    }
+
+		  c = TEXT (kw);
+		  /* Handle pragments.  */
+		  if (att == STYLE_II_COMMENT_SYMBOL
+		      || att == STYLE_I_COMMENT_SYMBOL
+		      || att == BOLD_COMMENT_SYMBOL
+		      || att == BOLD_COMMENT_BEGIN_SYMBOL
+		      || att == BRIEF_COMMENT_BEGIN_SYMBOL)
+		    {
+		      char *nlpr = pragment (ATTRIBUTE (kw), l, s);
+
+		      if (lpr == NO_TEXT || (int) strlen (lpr) == 0)
+			lpr = nlpr;
+		      else
+			{
+			  char *stale = lpr;
+			  lpr = a68_new_string (lpr, "\n\n", nlpr, NO_TEXT);
+			  free (stale);
+			}
+		      lprt = att;
+		      make_node = false;
+		    }
+		  else if (att == STYLE_I_PRAGMAT_SYMBOL
+			   || att == BOLD_PRAGMAT_SYMBOL)
+		    {
+		      char *nlpr = pragment (ATTRIBUTE (kw), l, s);
+		      if (lpr == NO_TEXT || (int) strlen (lpr) == 0)
+			lpr = nlpr;
+		      else
+			{
+			  char *stale = lpr;
+			  lpr = a68_new_string (lpr, "\n\n", nlpr, NO_TEXT);
+			  free (stale);
+			}
+		      lprt = att;
+		      if (!A68_PARSER (stop_scanner))
+			make_node = false;
+		    }
+		}
+	    }
+	  /* Add token to the tree.  */
+	  if (make_node)
+	    {
+	      NODE_T *q = a68_new_node ();
+	      INFO (q) = a68_new_node_info ();
+
+	      switch (att)
+		{
+		case ASSIGN_SYMBOL:
+		case END_SYMBOL:
+		case ESAC_SYMBOL:
+		case OD_SYMBOL:
+		case OF_SYMBOL:
+		case FI_SYMBOL:
+		case CLOSE_SYMBOL:
+		case BUS_SYMBOL:
+		case COLON_SYMBOL:
+		case COMMA_SYMBOL:
+		case SEMI_SYMBOL:
+		  GINFO (q) = NO_GINFO;
+		  break;
+		default:
+		  GINFO (q) = a68_new_genie_info ();
+		  break;
+		}
+
+	      STATUS (q) = (STATUS_MASK_T) 0;
+	      LINE (INFO (q)) = *start_l;
+	      CHAR_IN_LINE (INFO (q)) = *start_c;
+	      PRIO (INFO (q)) = 0;
+	      PROCEDURE_LEVEL (INFO (q)) = 0;
+	      ATTRIBUTE (q) = att;
+	      NSYMBOL (q) = c;
+	      PREVIOUS (q) = *root;
+	      SUB (q) = NEXT (q) = NO_NODE;
+	      TABLE (q) = NO_TABLE;
+	      MOID (q) = NO_MOID;
+	      TAX (q) = NO_TAG;
+	      if (lpr != NO_TEXT)
+		{
+		  NPRAGMENT (q) = lpr;
+		  NPRAGMENT_TYPE (q) = lprt;
+		  lpr = NO_TEXT;
+		  lprt = 0;
+		}
+	      if (*root != NO_NODE)
+		NEXT (*root) = q;
+	      if (TOP_NODE (&A68_JOB) == NO_NODE)
+		TOP_NODE (&A68_JOB) = q;
+	      *root = q;
+	      if (trailing != NO_TEXT)
+		a68_warning (q, 0,
+			     "ignoring trailing character H in A",
+			     trailing, att);
+	    }
+	  /* Redirection in tokenising formats. The scanner is a recursive-descent type as
+	     to know when it scans a format text and when not.  */
+	  if (in_format && att == FORMAT_DELIMITER_SYMBOL)
+	    return;
+	  else if (!in_format && att == FORMAT_DELIMITER_SYMBOL)
+	    tokenise_source (root, level + 1, true, l, s, start_l, start_c);
+	  else if (in_format && open_nested_clause (att))
+	    {
+	      NODE_T *z = PREVIOUS (*root);
+
+	      if (z != NO_NODE && a68_is_one_of (z, FORMAT_ITEM_N, FORMAT_ITEM_G, FORMAT_ITEM_H,
+						 FORMAT_ITEM_F, STOP))
+		{
+		  tokenise_source (root, level, false, l, s, start_l, start_c);
+		}
+	      else if (att == OPEN_SYMBOL)
+		ATTRIBUTE (*root) = FORMAT_OPEN_SYMBOL;
+	      else if (OPTION_BRACKETS (&A68_JOB) && att == SUB_SYMBOL)
+		ATTRIBUTE (*root) = FORMAT_OPEN_SYMBOL;
+	    }
+	  else if (!in_format && level > 0 && open_nested_clause (att))
+	    tokenise_source (root, level + 1, false, l, s, start_l, start_c);
+	  else if (!in_format && level > 0 && close_nested_clause (att))
+	    return;
+	  else if (in_format && att == CLOSE_SYMBOL)
+	    ATTRIBUTE (*root) = FORMAT_CLOSE_SYMBOL;
+	  else if (OPTION_BRACKETS (&A68_JOB) && in_format && att == BUS_SYMBOL)
+	    ATTRIBUTE (*root) = FORMAT_CLOSE_SYMBOL;
+	}
+    }
+}
+
+/* Tokenise source file, build initial syntax tree.  */
+
+bool
+a68_lexical_analyser (const char *filename)
+{
+  LINE_T *l = NO_LINE, *start_l = NO_LINE;
+  char *s = NO_TEXT, *start_c = NO_TEXT;
+  NODE_T *root = NO_NODE;
+
+  /* Read the source file into lines.  */
+  if (!read_source_file (filename))
+    return false;
+
+  /* Start tokenising.  */
+  A68_PARSER (stop_scanner) = false;
+  if ((l = TOP_LINE (&A68_JOB)) != NO_LINE)
+    s = STRING (l);
+  tokenise_source (&root, 0, false, &l, &s, &start_l, &start_c);
+
+  /* Note that A68_PARSER (scan_buf) and A68_PARSER (max_scan_buf_length) are
+     allocated by read_source_line.  */
+  free (A68_PARSER (scan_buf));
+  A68_PARSER (scan_buf) = NULL;
+  A68_PARSER (max_scan_buf_length) = 0;
+  return true;
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-scope.cc
@@ -0,0 +1,975 @@
+/* Static scope checker.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+/* A static scope checker inspects the source. Note that ALGOL 68 also needs
+   dynamic scope checking. This phase concludes the parser.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "options.h"
+
+#include "a68.h"
+
+typedef struct TUPLE_T TUPLE_T;
+typedef struct SCOPE_T SCOPE_T;
+
+struct TUPLE_T
+{
+  int level;
+  bool transient;
+};
+
+struct SCOPE_T
+{
+  NODE_T *where;
+  TUPLE_T tuple;
+  SCOPE_T *next;
+};
+
+enum { NOT_TRANSIENT = 0, TRANSIENT };
+
+static void gather_scopes_for_youngest (NODE_T *, SCOPE_T **);
+static void scope_statement (NODE_T *, SCOPE_T **);
+static void scope_enclosed_clause (NODE_T *, SCOPE_T **);
+static void scope_formula (NODE_T *, SCOPE_T **);
+static void scope_routine_text (NODE_T *, SCOPE_T **);
+
+/*
+ * Static scope checker.
+ */
+
+/* Scope_make_tuple.  */
+
+static TUPLE_T
+scope_make_tuple (int e, int t)
+{
+  static TUPLE_T z;
+  LEVEL (&z) = e;
+  TRANSIENT (&z) = t;
+  return z;
+}
+
+/* Link scope information into the list.  */
+
+static void
+scope_add (SCOPE_T **sl, NODE_T *p, TUPLE_T tup)
+{
+  if (sl != NO_VAR)
+    {
+      SCOPE_T *ns = (SCOPE_T *) xmalloc (sizeof (SCOPE_T));
+      WHERE (ns) = p;
+      TUPLE (ns) = tup;
+      NEXT (ns) = *sl;
+      *sl = ns;
+    }
+}
+
+/* Scope_check.  */
+
+static bool
+scope_check (SCOPE_T *top, int mask, int dest)
+{
+  int errors = 0;
+
+  /* Transient names cannot be stored.  */
+  if (mask & TRANSIENT)
+    {
+      for (SCOPE_T *s = top; s != NO_SCOPE; FORWARD (s))
+	{
+	  if (TRANSIENT (&TUPLE (s)) & TRANSIENT)
+	    {
+	      a68_error (WHERE (s), "attempt at storing a transient name");
+	      STATUS_SET (WHERE (s), SCOPE_ERROR_MASK);
+	      errors++;
+	    }
+	}
+    }
+
+  /* Potential scope violations.  */
+  for (SCOPE_T *s = top; s != NO_SCOPE; FORWARD (s))
+    {
+      if (dest < LEVEL (&TUPLE (s)) && !STATUS_TEST (WHERE (s), SCOPE_ERROR_MASK))
+	{
+	  MOID_T *ws = MOID (WHERE (s));
+
+	  if (ws != NO_MOID)
+	    {
+	      if (IS_REF (ws) || IS (ws, PROC_SYMBOL) || IS (ws, FORMAT_SYMBOL) || IS (ws, UNION_SYMBOL))
+		a68_warning (WHERE (s), OPT_Wscope, "M A is a potential scope violation",
+			     MOID (WHERE (s)), ATTRIBUTE (WHERE (s)));
+	    }
+	  STATUS_SET (WHERE (s), SCOPE_ERROR_MASK);
+	  errors++;
+	}
+    }
+  return (errors == 0);
+}
+
+/* Scope_check_multiple.  */
+
+static bool
+scope_check_multiple (SCOPE_T *top, int mask, SCOPE_T *dest)
+{
+  bool no_err = true;
+
+  for (; dest != NO_SCOPE; FORWARD (dest))
+    no_err = no_err && scope_check (top, mask, LEVEL (&TUPLE (dest)));
+  return no_err;
+}
+
+/* Check_identifier_usage.  */
+
+static void
+check_identifier_usage (TAG_T *t, NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, IDENTIFIER) && TAX (p) == t && ATTRIBUTE (MOID (t)) != PROC_SYMBOL)
+	a68_warning (p, OPT_Wuninitialized, "identifier S might be used uninitialised");
+      check_identifier_usage (t, SUB (p));
+    }
+}
+
+/* Scope_find_youngest_outside.  */
+
+static TUPLE_T
+scope_find_youngest_outside (SCOPE_T *s, int treshold)
+{
+  TUPLE_T z = scope_make_tuple (PRIMAL_SCOPE, NOT_TRANSIENT);
+
+  for (; s != NO_SCOPE; FORWARD (s))
+    {
+      if (LEVEL (&TUPLE (s)) > LEVEL (&z) && LEVEL (&TUPLE (s)) <= treshold)
+	z = TUPLE (s);
+    }
+  return z;
+}
+
+/* Scope_find_youngest.  */
+
+static TUPLE_T
+scope_find_youngest (SCOPE_T *s)
+{
+  return scope_find_youngest_outside (s, INT_MAX);
+}
+
+/*
+ * Routines for determining scope of ROUTINE TEXT or FORMAT TEXT.
+ */
+
+/* Get_declarer_elements.  */
+
+static void
+get_declarer_elements (NODE_T *p, SCOPE_T **r, bool no_ref)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, BOUNDS))
+	gather_scopes_for_youngest (SUB (p), r);
+      else if (IS (p, INDICANT))
+	{
+	  if (MOID (p) != NO_MOID && TAX (p) != NO_TAG && HAS_ROWS (MOID (p)) && no_ref)
+	    scope_add (r, p, scope_make_tuple (TAG_LEX_LEVEL (TAX (p)), NOT_TRANSIENT));
+	}
+      else if (IS_REF (p))
+	get_declarer_elements (NEXT (p), r, false);
+      else if (a68_is_one_of (p, PROC_SYMBOL, UNION_SYMBOL, STOP))
+	;
+      else
+	{
+	  get_declarer_elements (SUB (p), r, no_ref);
+	  get_declarer_elements (NEXT (p), r, no_ref);
+	}
+    }
+}
+
+/* Gather_scopes_for_youngest.  */
+
+static void
+gather_scopes_for_youngest (NODE_T *p, SCOPE_T **s)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if ((a68_is_one_of (p, ROUTINE_TEXT, FORMAT_TEXT, STOP))
+	  && (YOUNGEST_ENVIRON (TAX (p)) == PRIMAL_SCOPE))
+	{
+	  SCOPE_T *t = NO_SCOPE;
+	  TUPLE_T tup;
+
+	  gather_scopes_for_youngest (SUB (p), &t);
+	  tup = scope_find_youngest_outside (t, LEX_LEVEL (p));
+	  YOUNGEST_ENVIRON (TAX (p)) = LEVEL (&tup);
+	  /* Direct link into list iso "gather_scopes_for_youngest (SUB (p),
+	     s);".  */
+	  if (t != NO_SCOPE)
+	    {
+	      SCOPE_T *u = t;
+	      while (NEXT (u) != NO_SCOPE) {
+		FORWARD (u);
+	      }
+	      NEXT (u) = *s;
+	      (*s) = t;
+	    }
+	}
+      else if (a68_is_one_of (p, IDENTIFIER, OPERATOR, STOP))
+	{
+	  if (TAX (p) != NO_TAG && TAG_LEX_LEVEL (TAX (p)) != PRIMAL_SCOPE)
+	    scope_add (s, p, scope_make_tuple (TAG_LEX_LEVEL (TAX (p)), NOT_TRANSIENT));
+	}
+      else if (IS (p, DECLARER))
+	get_declarer_elements (p, s, true);
+      else
+	gather_scopes_for_youngest (SUB (p), s);
+  }
+}
+
+/* Get_youngest_environs.  */
+
+static void
+get_youngest_environs (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (a68_is_one_of (p, ROUTINE_TEXT, FORMAT_TEXT, STOP))
+	{
+	  SCOPE_T *s = NO_SCOPE;
+	  TUPLE_T tup;
+	  gather_scopes_for_youngest (SUB (p), &s);
+	  tup = scope_find_youngest_outside (s, LEX_LEVEL (p));
+	  YOUNGEST_ENVIRON (TAX (p)) = LEVEL (&tup);
+	}
+      else
+	get_youngest_environs (SUB (p));
+  }
+}
+
+/* Bind_scope_to_tag.  */
+
+static void
+bind_scope_to_tag (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, DEFINING_IDENTIFIER) && MOID (p) == M_FORMAT)
+	{
+	  if (IS (NEXT_NEXT (p), FORMAT_TEXT))
+	    {
+	      SCOPE (TAX (p)) = YOUNGEST_ENVIRON (TAX (NEXT_NEXT (p)));
+	      SCOPE_ASSIGNED (TAX (p)) = true;
+	    }
+	  return;
+	}
+      else if (IS (p, DEFINING_IDENTIFIER))
+	{
+	  if (IS (NEXT_NEXT (p), ROUTINE_TEXT))
+	    {
+	      SCOPE (TAX (p)) = YOUNGEST_ENVIRON (TAX (NEXT_NEXT (p)));
+	      SCOPE_ASSIGNED (TAX (p)) = true;
+	    }
+	  return;
+	}
+      else
+	bind_scope_to_tag (SUB (p));
+  }
+}
+
+/* Bind_scope_to_tags.  */
+
+static void
+bind_scope_to_tags (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (a68_is_one_of (p, PROCEDURE_DECLARATION, IDENTITY_DECLARATION, STOP))
+	bind_scope_to_tag (SUB (p));
+      else
+	bind_scope_to_tags (SUB (p));
+    }
+}
+
+/* Scope_bounds.  */
+
+static void
+scope_bounds (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, UNIT))
+	scope_statement (p, NO_VAR);
+      else
+	scope_bounds (SUB (p));
+    }
+}
+
+/* Scope_declarer.  */
+
+static void
+scope_declarer (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, BOUNDS))
+	scope_bounds (SUB (p));
+      else if (IS (p, INDICANT))
+	;
+      else if (IS_REF (p))
+	scope_declarer (NEXT (p));
+      else if (a68_is_one_of (p, PROC_SYMBOL, UNION_SYMBOL, STOP))
+	;
+      else
+	{
+	  scope_declarer (SUB (p));
+	  scope_declarer (NEXT (p));
+	}
+    }
+}
+
+/* Scope_identity_declaration.  */
+
+static void
+scope_identity_declaration (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      scope_identity_declaration (SUB (p));
+
+      if (IS (p, DEFINING_IDENTIFIER))
+	{
+	  NODE_T *unit = NEXT_NEXT (p);
+	  SCOPE_T *s = NO_SCOPE;
+	  TUPLE_T tup;
+	  int z = PRIMAL_SCOPE;
+
+	  if (ATTRIBUTE (MOID (TAX (p))) != PROC_SYMBOL)
+	    check_identifier_usage (TAX (p), unit);
+	  scope_statement (unit, &s);
+	  (void) scope_check (s, TRANSIENT, LEX_LEVEL (p));
+	  tup = scope_find_youngest (s);
+	  z = LEVEL (&tup);
+	  if (z < LEX_LEVEL (p))
+	    {
+	      SCOPE (TAX (p)) = z;
+	      SCOPE_ASSIGNED (TAX (p)) = true;
+	    }
+	  return;
+	}
+    }
+}
+
+/* Scope_variable_declaration.  */
+
+static void
+scope_variable_declaration (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      scope_variable_declaration (SUB (p));
+      if (IS (p, DECLARER))
+	scope_declarer (SUB (p));
+      else if (IS (p, DEFINING_IDENTIFIER))
+	{
+	  if (a68_whether (p, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP))
+	    {
+	      NODE_T *unit = NEXT_NEXT (p);
+	      SCOPE_T *s = NO_SCOPE;
+	      check_identifier_usage (TAX (p), unit);
+	      scope_statement (unit, &s);
+	      (void) scope_check (s, TRANSIENT, LEX_LEVEL (p));
+	      return;
+	    }
+	}
+    }
+}
+
+/* Scope_procedure_declaration.  */
+
+static void
+scope_procedure_declaration (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      scope_procedure_declaration (SUB (p));
+
+      if (a68_is_one_of (p, DEFINING_IDENTIFIER, DEFINING_OPERATOR, STOP))
+	{
+	  NODE_T *unit = NEXT_NEXT (p);
+	  SCOPE_T *s = NO_SCOPE;
+
+	  scope_statement (unit, &s);
+	  (void) scope_check (s, NOT_TRANSIENT, LEX_LEVEL (p));
+	  return;
+	}
+    }
+}
+
+/* Scope_declaration_list.  */
+
+static void
+scope_declaration_list (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, IDENTITY_DECLARATION))
+	scope_identity_declaration (SUB (p));
+      else if (IS (p, VARIABLE_DECLARATION))
+	scope_variable_declaration (SUB (p));
+      else if (IS (p, MODE_DECLARATION))
+	scope_declarer (SUB (p));
+      else if (IS (p, PRIORITY_DECLARATION))
+	;
+      else if (IS (p, PROCEDURE_DECLARATION))
+       scope_procedure_declaration (SUB (p));
+      else if (IS (p, PROCEDURE_VARIABLE_DECLARATION))
+	scope_procedure_declaration (SUB (p));
+      else if (a68_is_one_of (p, BRIEF_OPERATOR_DECLARATION, OPERATOR_DECLARATION, STOP))
+	scope_procedure_declaration (SUB (p));
+      else
+	{
+	  scope_declaration_list (SUB (p));
+	  scope_declaration_list (NEXT (p));
+	}
+    }
+}
+
+/* Scope_arguments.  */
+
+static void
+scope_arguments (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, UNIT))
+	{
+	  SCOPE_T *s = NO_SCOPE;
+	  scope_statement (p, &s);
+	  (void) scope_check (s, TRANSIENT, LEX_LEVEL (p));
+	}
+      else
+	scope_arguments (SUB (p));
+  }
+}
+
+/* Is_coercion.  */
+
+static bool
+is_coercion (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      switch (ATTRIBUTE (p))
+	{
+	case DEPROCEDURING:
+	case DEREFERENCING:
+	case UNITING:
+	case ROWING:
+	case WIDENING:
+	case VOIDING:
+	case PROCEDURING:
+	  return true;
+	default:
+	  return false;
+	}
+    }
+  else
+    return false;
+}
+
+/* Scope_coercion.  */
+
+static void
+scope_coercion (NODE_T *p, SCOPE_T **s)
+{
+  if (is_coercion (p))
+    {
+      if (IS (p, VOIDING))
+	scope_coercion (SUB (p), NO_VAR);
+      else if (IS (p, DEREFERENCING))
+	/* Leave this to the dynamic scope checker.  */
+	scope_coercion (SUB (p), NO_VAR);
+      else if (IS (p, DEPROCEDURING))
+	scope_coercion (SUB (p), NO_VAR);
+      else if (IS (p, ROWING))
+	{
+	  SCOPE_T *z = NO_SCOPE;
+
+	  scope_coercion (SUB (p), &z);
+	  (void) scope_check (z, TRANSIENT, LEX_LEVEL (p));
+	  if (IS_REF_FLEX (MOID (SUB (p))))
+	    scope_add (s, p, scope_make_tuple (LEX_LEVEL (p), TRANSIENT));
+	  else
+	    scope_add (s, p, scope_make_tuple (LEX_LEVEL (p), NOT_TRANSIENT));
+	}
+      else if (IS (p, PROCEDURING))
+	{
+	  /* Can only be a JUMP.  */
+	  NODE_T *q = SUB_SUB (p);
+	  if (IS (q, GOTO_SYMBOL))
+	    FORWARD (q);
+
+	  scope_add (s, q, scope_make_tuple (TAG_LEX_LEVEL (TAX (q)), NOT_TRANSIENT));
+	}
+      else if (IS (p, UNITING))
+	{
+	  SCOPE_T *z = NO_SCOPE;
+
+	  scope_coercion (SUB (p), &z);
+	  if (z != NO_SCOPE)
+	    {
+	      (void) scope_check (z, TRANSIENT, LEX_LEVEL (p));
+	      scope_add (s, p, scope_find_youngest (z));
+	    }
+	}
+      else
+	scope_coercion (SUB (p), s);
+    }
+  else
+    scope_statement (p, s);
+}
+
+/* Scope_format_text.  */
+
+static void
+scope_format_text (NODE_T *p, SCOPE_T **s)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, FORMAT_PATTERN))
+	scope_enclosed_clause (SUB (NEXT_SUB (p)), s);
+      else if (IS (p, FORMAT_ITEM_G) && NEXT (p) != NO_NODE)
+	scope_enclosed_clause (SUB_NEXT (p), s);
+      else if (IS (p, DYNAMIC_REPLICATOR))
+	scope_enclosed_clause (SUB (NEXT_SUB (p)), s);
+      else
+	scope_format_text (SUB (p), s);
+    }
+}
+
+/* Scope_operand.  */
+
+static void
+scope_operand (NODE_T *p, SCOPE_T **s)
+{
+  if (IS (p, MONADIC_FORMULA))
+    scope_operand (NEXT_SUB (p), s);
+  else if (IS (p, FORMULA))
+    scope_formula (p, s);
+  else if (IS (p, SECONDARY))
+    scope_statement (SUB (p), s);
+}
+
+/* Scope_formula.  */
+
+static void
+scope_formula (NODE_T *p, SCOPE_T **s)
+{
+  NODE_T *q = SUB (p);
+  SCOPE_T *s2 = NO_SCOPE;
+
+  scope_operand (q, &s2);
+  (void) scope_check (s2, TRANSIENT, LEX_LEVEL (p));
+  if (NEXT (q) != NO_NODE)
+    {
+      SCOPE_T *s3 = NO_SCOPE;
+      scope_operand (NEXT_NEXT (q), &s3);
+      (void) scope_check (s3, TRANSIENT, LEX_LEVEL (p));
+    }
+  (void) s;
+}
+
+/* Scope_routine_text.  */
+
+static void
+scope_routine_text (NODE_T *p, SCOPE_T **s)
+{
+  NODE_T *q = SUB (p);
+  NODE_T *routine = (IS (q, PARAMETER_PACK) ? NEXT (q) : q);
+  SCOPE_T *x = NO_SCOPE;
+
+  scope_statement (NEXT_NEXT (routine), &x);
+  (void) scope_check (x, TRANSIENT, LEX_LEVEL (p));
+  TUPLE_T routine_tuple = scope_make_tuple (YOUNGEST_ENVIRON (TAX (p)), NOT_TRANSIENT);
+  scope_add (s, p, routine_tuple);
+}
+
+/* Scope_statement.  */
+
+static void
+scope_statement (NODE_T *p, SCOPE_T **s)
+{
+  if (is_coercion (p))
+    scope_coercion (p, s);
+  else if (a68_is_one_of (p, PRIMARY, SECONDARY, TERTIARY, UNIT, STOP))
+    scope_statement (SUB (p), s);
+  else if (a68_is_one_of (p, NIHIL, STOP))
+    scope_add (s, p, scope_make_tuple (PRIMAL_SCOPE, NOT_TRANSIENT));
+  else if (IS (p, DENOTATION))
+    ;
+  else if (IS (p, IDENTIFIER))
+    {
+      if (IS_REF (MOID (p)))
+	{
+	  if (PRIO (TAX (p)) == PARAMETER_IDENTIFIER)
+	    scope_add (s, p, scope_make_tuple (TAG_LEX_LEVEL (TAX (p)) - 1, NOT_TRANSIENT));
+	  else
+	    {
+	      if (HEAP (TAX (p)) == HEAP_SYMBOL)
+		scope_add (s, p, scope_make_tuple (PRIMAL_SCOPE, NOT_TRANSIENT));
+	      else if (SCOPE_ASSIGNED (TAX (p)))
+		scope_add (s, p, scope_make_tuple (SCOPE (TAX (p)), NOT_TRANSIENT));
+	      else
+		scope_add (s, p, scope_make_tuple (TAG_LEX_LEVEL (TAX (p)), NOT_TRANSIENT));
+	    }
+	}
+      else if (ATTRIBUTE (MOID (p)) == PROC_SYMBOL && SCOPE_ASSIGNED (TAX (p)) == true)
+	scope_add (s, p, scope_make_tuple (SCOPE (TAX (p)), NOT_TRANSIENT));
+      else if (MOID (p) == M_FORMAT && SCOPE_ASSIGNED (TAX (p)) == true)
+	scope_add (s, p, scope_make_tuple (SCOPE (TAX (p)), NOT_TRANSIENT));
+    }
+  else if (IS (p, ENCLOSED_CLAUSE))
+    scope_enclosed_clause (SUB (p), s);
+  else if (IS (p, CALL))
+    {
+      SCOPE_T *x = NO_SCOPE;
+
+      scope_statement (SUB (p), &x);
+      (void) scope_check (x, NOT_TRANSIENT, LEX_LEVEL (p));
+      scope_arguments (NEXT_SUB (p));
+    }
+  else if (IS (p, SLICE))
+    {
+      SCOPE_T *x = NO_SCOPE;
+      MOID_T *m = MOID (SUB (p));
+
+      if (IS_REF (m))
+	{
+	  if (ATTRIBUTE (SUB (p)) == PRIMARY && ATTRIBUTE (SUB_SUB (p)) == SLICE)
+	    scope_statement (SUB (p), s);
+	  else
+	    {
+	      scope_statement (SUB (p), &x);
+	      (void) scope_check (x, NOT_TRANSIENT, LEX_LEVEL (p));
+	    }
+	  if (IS_FLEX (SUB (m)))
+	    scope_add (s, SUB (p), scope_make_tuple (LEX_LEVEL (p), TRANSIENT));
+	  scope_bounds (SUB (NEXT_SUB (p)));
+	}
+      if (IS_REF (MOID (p)))
+	scope_add (s, p, scope_find_youngest (x));
+    }
+  else if (IS (p, FORMAT_TEXT))
+    {
+      SCOPE_T *x = NO_SCOPE;
+      scope_format_text (SUB (p), &x);
+      scope_add (s, p, scope_find_youngest (x));
+    }
+  else if (IS (p, CAST))
+    {
+      SCOPE_T *x = NO_SCOPE;
+      scope_enclosed_clause (SUB (NEXT_SUB (p)), &x);
+      (void) scope_check (x, NOT_TRANSIENT, LEX_LEVEL (p));
+      scope_add (s, p, scope_find_youngest (x));
+    }
+  else if (IS (p, SELECTION))
+    {
+      SCOPE_T *ns = NO_SCOPE;
+      scope_statement (NEXT_SUB (p), &ns);
+      (void) scope_check (ns, NOT_TRANSIENT, LEX_LEVEL (p));
+      if (a68_is_ref_refety_flex (MOID (NEXT_SUB (p))))
+	scope_add (s, p, scope_make_tuple (LEX_LEVEL (p), TRANSIENT));
+      scope_add (s, p, scope_find_youngest (ns));
+  }
+  else if (IS (p, GENERATOR))
+    {
+      if (IS (SUB (p), LOC_SYMBOL))
+	{
+	  if (NON_LOCAL (p) != NO_TABLE)
+	    scope_add (s, p, scope_make_tuple (LEVEL (NON_LOCAL (p)), NOT_TRANSIENT));
+	  else
+	    scope_add (s, p, scope_make_tuple (LEX_LEVEL (p), NOT_TRANSIENT));
+	}
+      else
+	scope_add (s, p, scope_make_tuple (PRIMAL_SCOPE, NOT_TRANSIENT));
+      scope_declarer (SUB (NEXT_SUB (p)));
+    }
+  else if (IS (p, FORMULA))
+    scope_formula (p, s);
+  else if (IS (p, ASSIGNATION))
+    {
+      NODE_T *unit = NEXT (NEXT_SUB (p));
+      SCOPE_T *ns = NO_SCOPE, *nd = NO_SCOPE;
+      TUPLE_T tup;
+      scope_statement (SUB_SUB (p), &nd);
+      scope_statement (unit, &ns);
+      (void) scope_check_multiple (ns, TRANSIENT, nd);
+      tup = scope_find_youngest (nd);
+      scope_add (s, p, scope_make_tuple (LEVEL (&tup), NOT_TRANSIENT));
+    }
+  else if (IS (p, ROUTINE_TEXT))
+    scope_routine_text (p, s);
+  else if (a68_is_one_of (p, IDENTITY_RELATION, AND_FUNCTION, OR_FUNCTION, STOP))
+    {
+      SCOPE_T *n = NO_SCOPE;
+      scope_statement (SUB (p), &n);
+      scope_statement (NEXT (NEXT_SUB (p)), &n);
+      (void) scope_check (n, NOT_TRANSIENT, LEX_LEVEL (p));
+    }
+  else if (IS (p, ASSERTION))
+    {
+      SCOPE_T *n = NO_SCOPE;
+      scope_enclosed_clause (SUB (NEXT_SUB (p)), &n);
+      (void) scope_check (n, NOT_TRANSIENT, LEX_LEVEL (p));
+    }
+  else if (a68_is_one_of (p, JUMP, SKIP, STOP))
+    {
+      ;
+    }
+}
+
+/* Scope_statement_list.  */
+
+static void
+scope_statement_list (NODE_T *p, SCOPE_T **s)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, UNIT))
+	scope_statement (p, s);
+      else
+	scope_statement_list (SUB (p), s);
+    }
+}
+
+/* Scope_serial_clause.  */
+
+static void
+scope_serial_clause (NODE_T *p, SCOPE_T **s, bool terminator)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, INITIALISER_SERIES))
+	{
+	  scope_serial_clause (SUB (p), s, false);
+	  scope_serial_clause (NEXT (p), s, terminator);
+	}
+      else if (IS (p, DECLARATION_LIST))
+	scope_declaration_list (SUB (p));
+      else if (a68_is_one_of (p, LABEL, SEMI_SYMBOL, EXIT_SYMBOL, STOP))
+	scope_serial_clause (NEXT (p), s, terminator);
+      else if (a68_is_one_of (p, SERIAL_CLAUSE, ENQUIRY_CLAUSE, STOP))
+	{
+	  if (NEXT (p) != NO_NODE)
+	    {
+	      int j = ATTRIBUTE (NEXT (p));
+	      if (j == EXIT_SYMBOL || j == END_SYMBOL || j == CLOSE_SYMBOL)
+		scope_serial_clause (SUB (p), s, true);
+	      else
+		scope_serial_clause (SUB (p), s, false);
+	    }
+	  else
+	    scope_serial_clause (SUB (p), s, true);
+	  scope_serial_clause (NEXT (p), s, terminator);
+	}
+      else if (IS (p, LABELED_UNIT))
+	scope_serial_clause (SUB (p), s, terminator);
+      else if (IS (p, UNIT))
+	{
+	  if (terminator)
+	    scope_statement (p, s);
+	  else
+	    scope_statement (p, NO_VAR);
+	}
+    }
+}
+
+/* Scope_closed_clause.  */
+
+static void
+scope_closed_clause (NODE_T *p, SCOPE_T **s)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, SERIAL_CLAUSE))
+	scope_serial_clause (p, s, true);
+      else if (a68_is_one_of (p, OPEN_SYMBOL, BEGIN_SYMBOL, STOP))
+	scope_closed_clause (NEXT (p), s);
+    }
+}
+
+/* Scope_collateral_clause.  */
+
+static void
+scope_collateral_clause (NODE_T *p, SCOPE_T **s)
+{
+  if (p != NO_NODE)
+    {
+      if (!(a68_whether (p, BEGIN_SYMBOL, END_SYMBOL, STOP)
+	    || a68_whether (p, OPEN_SYMBOL, CLOSE_SYMBOL, STOP)))
+	{
+	  scope_statement_list (p, s);
+	}
+    }
+}
+
+/* Scope_conditional_clause.  */
+
+static void
+scope_conditional_clause (NODE_T *p, SCOPE_T **s)
+{
+  scope_serial_clause (NEXT_SUB (p), NO_VAR, true);
+  FORWARD (p);
+  scope_serial_clause (NEXT_SUB (p), s, true);
+  if ((FORWARD (p)) != NO_NODE)
+    {
+      if (a68_is_one_of (p, ELSE_PART, CHOICE, STOP))
+	scope_serial_clause (NEXT_SUB (p), s, true);
+      else if (a68_is_one_of (p, ELIF_PART, BRIEF_ELIF_PART, STOP))
+	scope_conditional_clause (SUB (p), s);
+    }
+}
+
+/* Scope_case_clause.  */
+
+static void
+scope_case_clause (NODE_T *p, SCOPE_T **s)
+{
+  SCOPE_T *n = NO_SCOPE;
+  scope_serial_clause (NEXT_SUB (p), &n, true);
+  (void) scope_check (n, NOT_TRANSIENT, LEX_LEVEL (p));
+  FORWARD (p);
+  scope_statement_list (NEXT_SUB (p), s);
+  if ((FORWARD (p)) != NO_NODE)
+    {
+      if (a68_is_one_of (p, OUT_PART, CHOICE, STOP))
+	scope_serial_clause (NEXT_SUB (p), s, true);
+      else if (a68_is_one_of (p, CASE_OUSE_PART, BRIEF_OUSE_PART, STOP))
+	scope_case_clause (SUB (p), s);
+      else if (a68_is_one_of (p, CONFORMITY_OUSE_PART, BRIEF_CONFORMITY_OUSE_PART, STOP))
+	scope_case_clause (SUB (p), s);
+    }
+}
+
+/* Scope_loop_clause.  */
+
+static void
+scope_loop_clause (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, FOR_PART))
+	scope_loop_clause (NEXT (p));
+      else if (a68_is_one_of (p, FROM_PART, BY_PART, TO_PART, STOP))
+	{
+	  scope_statement (NEXT_SUB (p), NO_VAR);
+	  scope_loop_clause (NEXT (p));
+	}
+      else if (IS (p, WHILE_PART))
+	{
+	  scope_serial_clause (NEXT_SUB (p), NO_VAR, true);
+	  scope_loop_clause (NEXT (p));
+	}
+      else if (a68_is_one_of (p, DO_PART, ALT_DO_PART, STOP))
+	{
+	  NODE_T *do_p = NEXT_SUB (p);
+
+	  if (IS (do_p, SERIAL_CLAUSE))
+	    scope_serial_clause (do_p, NO_VAR, true);
+	}
+    }
+}
+
+/* Scope_enclosed_clause.  */
+
+static void
+scope_enclosed_clause (NODE_T *p, SCOPE_T **s)
+{
+  if (IS (p, ENCLOSED_CLAUSE))
+    scope_enclosed_clause (SUB (p), s);
+  else if (IS (p, CLOSED_CLAUSE))
+    scope_closed_clause (SUB (p), s);
+  else if (a68_is_one_of (p, COLLATERAL_CLAUSE, PARALLEL_CLAUSE, STOP))
+    scope_collateral_clause (SUB (p), s);
+  else if (IS (p, CONDITIONAL_CLAUSE))
+    scope_conditional_clause (SUB (p), s);
+  else if (a68_is_one_of (p, CASE_CLAUSE, CONFORMITY_CLAUSE, STOP))
+    scope_case_clause (SUB (p), s);
+  else if (IS (p, LOOP_CLAUSE))
+    scope_loop_clause (SUB (p));
+}
+
+/* Whether a symbol table contains no (anonymous) definition.  */
+
+static bool
+empty_table (TABLE_T * t)
+{
+  if (IDENTIFIERS (t) == NO_TAG)
+    return (OPERATORS (t) == NO_TAG && INDICANTS (t) == NO_TAG);
+  else if (PRIO (IDENTIFIERS (t)) == LOOP_IDENTIFIER && NEXT (IDENTIFIERS (t)) == NO_TAG)
+    return (OPERATORS (t) == NO_TAG && INDICANTS (t) == NO_TAG);
+  else if (PRIO (IDENTIFIERS (t)) == SPECIFIER_IDENTIFIER && NEXT (IDENTIFIERS (t)) == NO_TAG)
+    return (OPERATORS (t) == NO_TAG && INDICANTS (t) == NO_TAG);
+  else
+    return false;
+}
+
+/* Indicate non-local environs.  */
+
+static void
+get_non_local_environs (NODE_T *p, int max)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, ROUTINE_TEXT))
+	get_non_local_environs (SUB (p), LEX_LEVEL (SUB (p)));
+      else if (IS (p, FORMAT_TEXT))
+	get_non_local_environs (SUB (p), LEX_LEVEL (SUB (p)));
+      else
+	{
+	  get_non_local_environs (SUB (p), max);
+	  NON_LOCAL (p) = NO_TABLE;
+	  if (TABLE (p) != NO_TABLE)
+	    {
+	      TABLE_T *q = TABLE (p);
+	      while (q != NO_TABLE && empty_table (q)
+		     && PREVIOUS (q) != NO_TABLE && LEVEL (PREVIOUS (q)) >= max)
+		{
+		  NON_LOCAL (p) = PREVIOUS (q);
+		  q = PREVIOUS (q);
+		}
+	    }
+	}
+    }
+}
+
+/* The static scope checker.  */
+
+void
+a68_scope_checker (NODE_T *p)
+{
+  /* Establish scopes of routine texts and format texts.  */
+  get_youngest_environs (p);
+  /* Find non-local environs.  */
+  get_non_local_environs (p, PRIMAL_SCOPE);
+  /* PROC and FORMAT identities can now be assigned a scope.  */
+  bind_scope_to_tags (p);
+  /* Now check evertyhing else.  */
+  scope_enclosed_clause (SUB (p), NO_VAR);
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-serial-dsa.cc
@@ -0,0 +1,114 @@
+/* Check dynamic stack usage in serial clauses.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Written by Jose E. Marchesi.
+
+   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 file implements a phase that determines what serial clauses contain
+   phrases whose elaboration may involve dynamic stack allocation.  It
+   annotates the SERIAL_CLAUSE parse nodes by setting the DYNAMIC_STACK_ALLOCS
+   flag.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "options.h"
+
+#include "a68.h"
+
+/* Uncomment the following line for debugging traces.  */
+/* #define SERIAL_DSA_DEBUG */
+
+static void
+serial_dsa_check_serial_clause (NODE_T *p, bool *dsa)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, GENERATOR))
+	{
+	  /* LOC generators always result in dyamic stack allocation regardless
+	     of the mode of the allocated value.  */
+	  if (IS (SUB (p), LOC_SYMBOL))
+	    {
+#ifdef SERIAL_DSA_DEBUG
+	      fprintf (stderr, "serial_dsa: %s:%d: loc generator implies DSA\n",
+		       FILENAME (LINE (INFO (p))),
+		       LINE_NUMBER (p));
+#endif
+	      *dsa = true;
+	      return;
+	    }
+	}
+      else if (IS (p, DEFINING_IDENTIFIER))
+	{
+	  /* Variable declarations of values with sample loc generators will
+	     result in dynamic stack allocation.
+
+	     Note that label declarations do no have a mode, so we have to
+	     check for MOID (p).  */
+
+	  if (MOID (p) != NO_MOID && IS_REF (MOID (p)))
+	    {
+	      bool heap = HEAP (TAX (p)) == HEAP_SYMBOL;
+	      if (HAS_ROWS (SUB (MOID (p))) && !heap)
+		{
+#ifdef SERIAL_DSA_DEBUG		  
+		  fprintf (stderr,
+			   "serial_dsa: %s:%d: defining identifier %s implies DSA\n",
+			   FILENAME (LINE (INFO (p))),
+			   LINE_NUMBER (p),
+			   NSYMBOL (p));
+#endif
+		  *dsa = true;
+		  return;
+		}
+	    }
+	}
+      else
+	{
+	  /* Inner serial clauses will take care of their own.  Code in routine
+	     texts will not impact the stack of the containing serial
+	     clause.  */
+	  if (!IS (p, SERIAL_CLAUSE) && !IS (p, ROUTINE_TEXT))
+	    serial_dsa_check_serial_clause (SUB (p), dsa);
+	}
+    }
+}
+
+void
+a68_serial_dsa (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      a68_serial_dsa (SUB (p));
+      if (IS (p, SERIAL_CLAUSE))
+	{
+	  bool dsa = false;
+	  serial_dsa_check_serial_clause (SUB (p), &dsa);
+	  DYNAMIC_STACK_ALLOCS (p) = dsa;
+#ifdef SERIAL_DSA_DEBUG
+	  if (dsa)
+	    {
+	      fprintf (stderr, "serial_dsa: %s:%d: marking serial clause %p as DSA\n",
+		       FILENAME (LINE (INFO (p))),
+		       LINE_NUMBER (p),
+		       (void *) p);
+	    }
+	  
+#endif
+	}
+    }
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-taxes.cc
@@ -0,0 +1,1681 @@
+/* Symbol table management.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "options.h"
+
+#include "a68.h"
+
+/*
+ * Symbol table handling, managing TAGS.
+ */
+
+/* Forward declarations for several functions defined below.  */
+
+static TAG_T *find_tag_local (TABLE_T *table, int a, const char *name);
+
+/* Set level for procedures.  */
+
+void
+a68_set_proc_level (NODE_T *p, int n)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      PROCEDURE_LEVEL (INFO (p)) = n;
+      if (IS (p, ROUTINE_TEXT))
+	a68_set_proc_level (SUB (p), n + 1);
+      else
+	a68_set_proc_level (SUB (p), n);
+    }
+}
+
+/* Set nests for diagnostics.  */
+
+void
+a68_set_nest (NODE_T *p, NODE_T *s)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      NEST (p) = s;
+      if (IS (p, PARTICULAR_PROGRAM))
+	a68_set_nest (SUB (p), p);
+      else if (IS (p, CLOSED_CLAUSE) && LINE_NUMBER (p) != 0)
+	a68_set_nest (SUB (p), p);
+      else if (IS (p, COLLATERAL_CLAUSE) && LINE_NUMBER (p) != 0)
+	a68_set_nest (SUB (p), p);
+      else if (IS (p, CONDITIONAL_CLAUSE) && LINE_NUMBER (p) != 0)
+	a68_set_nest (SUB (p), p);
+      else if (IS (p, CASE_CLAUSE) && LINE_NUMBER (p) != 0)
+	a68_set_nest (SUB (p), p);
+      else if (IS (p, CONFORMITY_CLAUSE) && LINE_NUMBER (p) != 0)
+	a68_set_nest (SUB (p), p);
+      else if (IS (p, LOOP_CLAUSE) && LINE_NUMBER (p) != 0)
+	a68_set_nest (SUB (p), p);
+      else
+	a68_set_nest (SUB (p), s);
+    }
+}
+
+/*
+ * Routines that work with tags and symbol tables.
+ */
+
+static void tax_tags (NODE_T *);
+static void tax_specifier_list (NODE_T *);
+static void tax_parameter_list (NODE_T *);
+static void tax_format_texts (NODE_T *);
+
+/* Find a tag, searching symbol tables towards the root.  */
+
+int
+a68_first_tag_global (TABLE_T * table, const char *name)
+{
+  if (table != NO_TABLE)
+    {
+      for (TAG_T *s = IDENTIFIERS (table); s != NO_TAG; FORWARD (s))
+	{
+	  if (NSYMBOL (NODE (s)) == name)
+	    return IDENTIFIER;
+	}
+      for (TAG_T *s = INDICANTS (table); s != NO_TAG; FORWARD (s))
+	{
+	  if (NSYMBOL (NODE (s)) == name)
+	    return INDICANT;
+	}
+      for (TAG_T *s = LABELS (table); s != NO_TAG; FORWARD (s))
+	{
+	  if (NSYMBOL (NODE (s)) == name)
+	    return LABEL;
+	}
+      for (TAG_T *s = OPERATORS (table); s != NO_TAG; FORWARD (s))
+	{
+	  if (NSYMBOL (NODE (s)) == name)
+	    return OP_SYMBOL;
+	}
+      for (TAG_T *s = PRIO (table); s != NO_TAG; FORWARD (s))
+	{
+	  if (NSYMBOL (NODE (s)) == name)
+	    return PRIO_SYMBOL;
+	}
+      return a68_first_tag_global (PREVIOUS (table), name);
+    }
+  else
+    return STOP;
+}
+
+/* Check portability of sub tree.  */
+
+static void
+portcheck (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      portcheck (SUB (p));
+      if (IS (p, INDICANT) && MOID (p) != NO_MOID)
+	{
+	  if (!PORTABLE (MOID (p)))
+	    a68_warning (p, OPT_Wextensions, "tag S is not portable", p);
+	  PORTABLE (MOID (p)) = true;
+	}
+      else if (IS (p, IDENTIFIER))
+	{
+	  if (!PORTABLE (TAX (p)))
+	    a68_warning (p, OPT_Wextensions, "tag S is not portable", p);
+	  PORTABLE (TAX (p)) = true;
+	}
+      else if (IS (p, OPERATOR))
+	{
+	  if (!PORTABLE (TAX (p)))
+	    a68_warning (p, OPT_Wextensions, "tag S is not portable", p);
+	  PORTABLE (TAX (p)) = true;
+	}
+      else if (IS (p, ASSERTION))
+	{
+	  a68_warning (p, OPT_Wextensions, "tag S is not portable");
+	}
+    }
+}
+
+/* Whether routine can be "lengthety-mapped".  */
+
+static bool
+is_mappable_routine (char *z)
+{
+#define ACCEPT(u, v) {\
+  if (strlen (u) >= strlen (v)) {\
+    if (strcmp (&u[strlen (u) - strlen (v)], v) == 0) {\
+      return true;\
+  }}}
+
+  /* Math routines.  */
+  ACCEPT (z, "arccos");
+  ACCEPT (z, "arccosdg");
+  ACCEPT (z, "arccot");
+  ACCEPT (z, "arccotdg");
+  ACCEPT (z, "arcsin");
+  ACCEPT (z, "arcsindg");
+  ACCEPT (z, "arctan");
+  ACCEPT (z, "arctandg");
+  ACCEPT (z, "beta");
+  ACCEPT (z, "betainc");
+  ACCEPT (z, "cbrt");
+  ACCEPT (z, "cos");
+  ACCEPT (z, "cosdg");
+  ACCEPT (z, "cospi");
+  ACCEPT (z, "cot");
+  ACCEPT (z, "cot");
+  ACCEPT (z, "cotdg");
+  ACCEPT (z, "cotpi");
+  ACCEPT (z, "curt");
+  ACCEPT (z, "erf");
+  ACCEPT (z, "erfc");
+  ACCEPT (z, "exp");
+  ACCEPT (z, "gamma");
+  ACCEPT (z, "gammainc");
+  ACCEPT (z, "gammaincg");
+  ACCEPT (z, "gammaincgf");
+  ACCEPT (z, "ln");
+  ACCEPT (z, "log");
+  ACCEPT (z, "pi");
+  ACCEPT (z, "sin");
+  ACCEPT (z, "sindg");
+  ACCEPT (z, "sinpi");
+  ACCEPT (z, "sqrt");
+  ACCEPT (z, "tan");
+  ACCEPT (z, "tandg");
+  ACCEPT (z, "tanpi");
+  /* Random generator.  */
+  ACCEPT (z, "nextrandom");
+  ACCEPT (z, "random");
+  /* BITS.  */
+  ACCEPT (z, "bitspack");
+  /* Enquiries.  */
+  ACCEPT (z, "maxint");
+  ACCEPT (z, "intwidth");
+  ACCEPT (z, "maxreal");
+  ACCEPT (z, "realwidth");
+  ACCEPT (z, "expwidth");
+  ACCEPT (z, "maxbits");
+  ACCEPT (z, "bitswidth");
+  ACCEPT (z, "byteswidth");
+  ACCEPT (z, "smallreal");
+  return false;
+#undef ACCEPT
+}
+
+/* Map "short sqrt" onto "sqrt" etcetera.  */
+
+static TAG_T *
+bind_lengthety_identifier (const char *u)
+{
+#define CAR(u, v) (strncmp (u, v, strlen(v)) == 0)
+  /* We can only map routines blessed by "is_mappable_routine", so there is no
+     "short print" or "long char in string". */
+  if (CAR (u, "short"))
+    {
+      do
+	{
+	  u = &u[strlen ("short")];
+	  char *v = TEXT (a68_add_token (&A68 (top_token), u));
+	  TAG_T *w = find_tag_local (A68_STANDENV, IDENTIFIER, v);
+	  if (w != NO_TAG && is_mappable_routine (v))
+	    return w;
+	}
+      while (CAR (u, "short"));
+    }
+  else if (CAR (u, "long"))
+    {
+      do
+	{
+	  u = &u[strlen ("long")];
+	  char *v = TEXT (a68_add_token (&A68 (top_token), u));
+	  TAG_T *w = find_tag_local (A68_STANDENV, IDENTIFIER, v);
+	  if (w != NO_TAG && is_mappable_routine (v))
+	    return w;
+	}
+      while (CAR (u, "long"));
+    }
+
+  return NO_TAG;
+#undef CAR
+}
+
+/* Bind identifier tags to the symbol table.  */
+
+static void
+bind_identifier_tag_to_symbol_table (NODE_T * p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      bind_identifier_tag_to_symbol_table (SUB (p));
+
+      if (a68_is_one_of (p, IDENTIFIER, DEFINING_IDENTIFIER, STOP))
+	{
+	  int att = a68_first_tag_global (TABLE (p), NSYMBOL (p));
+
+	  if (att == STOP)
+	    {
+	      TAG_T *z = bind_lengthety_identifier (NSYMBOL (p));
+
+	      if (z != NO_TAG)
+		MOID (p) = MOID (z);
+	      TAX (p) = z;
+	    }
+	  else
+	    {
+	      TAG_T *z = a68_find_tag_global (TABLE (p), att, NSYMBOL (p));
+
+	      if (att == IDENTIFIER && z != NO_TAG)
+		MOID (p) = MOID (z);
+	      else if (att == LABEL && z != NO_TAG)
+		;
+	      else if ((z = bind_lengthety_identifier (NSYMBOL (p))) != NO_TAG)
+		MOID (p) = MOID (z);
+	      else
+		{
+		  a68_error (p, "tag S has not been declared properly");
+		  z = a68_add_tag (TABLE (p), IDENTIFIER, p, M_ERROR, NORMAL_IDENTIFIER);
+		  MOID (p) = M_ERROR;
+		}
+	      TAX (p) = z;
+	      if (IS (p, DEFINING_IDENTIFIER))
+		NODE (z) = p;
+	    }
+	}
+    }
+}
+
+/* Tell whether the given tree refers to the applied indicant INDICANT in an
+   actual declarer.  */
+
+static bool
+declarer_contains_indicant (NODE_T *p, NODE_T *indicant)
+{
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (IS (q, DECLARER)
+	  && IS (SUB (q), INDICANT)
+	  && ((TAX (SUB (q)) && IS_RECURSIVE (TAX (SUB (q))))
+	      || IS_LITERALLY (SUB (q), NSYMBOL (indicant))))
+	{
+	  return true;
+	}
+
+      if (declarer_contains_indicant (SUB (q), indicant))
+	return true;
+    }
+
+  return false;
+}
+
+/* Bind indicant tags to the symbol table.  */
+
+static void
+bind_indicant_tag_to_symbol_table (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      bind_indicant_tag_to_symbol_table (SUB (p));
+
+      if (a68_is_one_of (p, INDICANT, DEFINING_INDICANT, STOP))
+	{
+	  TAG_T *z = a68_find_tag_global (TABLE (p), INDICANT, NSYMBOL (p));
+
+	  if (z != NO_TAG)
+	    {
+	      MOID (p) = MOID (z);
+	      TAX (p) = z;
+	      if (IS (p, DEFINING_INDICANT))
+		{
+		  NODE (z) = p;
+		  IS_RECURSIVE (z) = declarer_contains_indicant (NEXT_NEXT (p), p);
+		}
+	    }
+	}
+    }
+}
+
+/* Enter specifier identifiers in the symbol table.  */
+
+static void
+tax_specifiers (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      tax_specifiers (SUB (p));
+
+      if (SUB (p) != NO_NODE && IS (p, SPECIFIER))
+	tax_specifier_list (SUB (p));
+    }
+}
+
+/* Enter specifier identifiers in the symbol table.  */
+
+static void
+tax_specifier_list (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, OPEN_SYMBOL))
+	tax_specifier_list (NEXT (p));
+      else if (a68_is_one_of (p, CLOSE_SYMBOL, VOID_SYMBOL, STOP))
+	;
+      else if (IS (p, IDENTIFIER))
+	{
+	  TAG_T *z = a68_add_tag (TABLE (p), IDENTIFIER, p, NO_MOID, SPECIFIER_IDENTIFIER);
+	  HEAP (z) = LOC_SYMBOL;
+	}
+      else if (IS (p, DECLARER))
+	{
+	  tax_specifiers (SUB (p));
+	  tax_specifier_list (NEXT (p));
+	  /* last identifier entry is identifier with this declarer.  */
+	  if (IDENTIFIERS (TABLE (p)) != NO_TAG
+	      && PRIO (IDENTIFIERS (TABLE (p))) == SPECIFIER_IDENTIFIER)
+	    MOID (IDENTIFIERS (TABLE (p))) = MOID (p);
+	}
+    }
+}
+
+/* Enter parameter identifiers in the symbol table.  */
+
+static void
+tax_parameters (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (SUB (p) != NO_NODE)
+	{
+	  tax_parameters (SUB (p));
+	  if (IS (p, PARAMETER_PACK))
+	    tax_parameter_list (SUB (p));
+	}
+    }
+}
+
+/* Enter parameter identifiers in the symbol table.  */
+
+static void
+tax_parameter_list (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (a68_is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, STOP))
+      tax_parameter_list (NEXT (p));
+      else if (IS (p, CLOSE_SYMBOL))
+	;
+      else if (a68_is_one_of (p, PARAMETER_LIST, PARAMETER, STOP))
+	{
+	  tax_parameter_list (NEXT (p));
+	  tax_parameter_list (SUB (p));
+	}
+      else if (IS (p, IDENTIFIER))
+	{
+	  /* parameters are always local.  */
+	  HEAP (a68_add_tag (TABLE (p), IDENTIFIER, p, NO_MOID, PARAMETER_IDENTIFIER)) = LOC_SYMBOL;
+	}
+      else if (IS (p, DECLARER))
+	{
+	  tax_parameter_list (NEXT (p));
+	  /* last identifier entries are identifiers with this declarer.  */
+	  for (TAG_T *s = IDENTIFIERS (TABLE (p)); s != NO_TAG && MOID (s) == NO_MOID; FORWARD (s))
+	    MOID (s) = MOID (p);
+	  tax_parameters (SUB (p));
+	}
+    }
+}
+
+/* Enter FOR identifiers in the symbol table.  */
+
+static void
+tax_for_identifiers (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      tax_for_identifiers (SUB (p));
+
+      if (IS (p, FOR_SYMBOL))
+	{
+	  if ((FORWARD (p)) != NO_NODE)
+	    (void) a68_add_tag (TABLE (p), IDENTIFIER, p, M_INT, LOOP_IDENTIFIER);
+	}
+    }
+}
+
+/* Enter routine texts in the symbol table.  */
+
+static void
+tax_routine_texts (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      tax_routine_texts (SUB (p));
+
+      if (IS (p, ROUTINE_TEXT))
+	{
+	  TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, MOID (p), ROUTINE_TEXT);
+	  TAX (p) = z;
+	  HEAP (z) = LOC_SYMBOL;
+	  USE (z) = true;
+	}
+    }
+}
+
+/* Enter format texts in the symbol table.  */
+
+static void
+tax_format_texts (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      tax_format_texts (SUB (p));
+
+      if (IS (p, FORMAT_TEXT))
+	{
+	  TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, M_FORMAT, FORMAT_TEXT);
+	  TAX (p) = z;
+	  USE (z) = true;
+	}
+      else if (IS (p, FORMAT_DELIMITER_SYMBOL) && NEXT (p) != NO_NODE)
+	{
+	  TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, M_FORMAT, FORMAT_IDENTIFIER);
+	  TAX (p) = z;
+	  USE (z) = true;
+	}
+    }
+}
+
+/* Enter FORMAT pictures in the symbol table.  */
+
+static void
+tax_pictures (NODE_T * p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      tax_pictures (SUB (p));
+
+      if (IS (p, PICTURE))
+	TAX (p) = a68_add_tag (TABLE (p), ANONYMOUS, p, M_COLLITEM, FORMAT_IDENTIFIER);
+    }
+}
+
+/* Enter generators in the symbol table.  */
+
+static void
+tax_generators (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      tax_generators (SUB (p));
+
+      if (IS (p, GENERATOR))
+	{
+	  if (IS (SUB (p), LOC_SYMBOL))
+	    {
+	      TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, SUB_MOID (SUB (p)), GENERATOR);
+	      HEAP (z) = LOC_SYMBOL;
+	      USE (z) = true;
+	      TAX (p) = z;
+	    }
+	}
+    }
+}
+
+/* Find a firmly related operator for operands.  */
+
+static TAG_T *
+find_firmly_related_op (TABLE_T *c, const char *n, MOID_T *l, MOID_T *r, TAG_T *self)
+{
+  if (c != NO_TABLE)
+    {
+      TAG_T *s = OPERATORS (c);
+
+      for (; s != NO_TAG; FORWARD (s))
+	{
+	  if (s != self && NSYMBOL (NODE (s)) == n)
+	    {
+	      PACK_T *t = PACK (MOID (s));
+	      if (t != NO_PACK && a68_is_firm (MOID (t), l))
+		{
+		  /* catch monadic operator.  */
+		  if ((FORWARD (t)) == NO_PACK)
+		    {
+		      if (r == NO_MOID)
+			  return s;
+		    }
+		  else
+		    {
+		      /* catch dyadic operator.  */
+		      if (r != NO_MOID && a68_is_firm (MOID (t), r))
+			return s;
+		    }
+		}
+	    }
+	}
+    }
+  return NO_TAG;
+}
+
+/* Check for firmly related operators in this range.  */
+
+static void
+test_firmly_related_ops_local (NODE_T *p, TAG_T *s)
+{
+  if (s != NO_TAG)
+    {
+      PACK_T *u = PACK (MOID (s));
+
+      if (u != NO_PACK)
+	{
+	  MOID_T *l = MOID (u);
+	  MOID_T *r = (NEXT (u) != NO_PACK ? MOID (NEXT (u)) : NO_MOID);
+	  TAG_T *t = find_firmly_related_op (TAG_TABLE (s), NSYMBOL (NODE (s)), l, r, s);
+
+	  if (t != NO_TAG)
+	    {
+	      a68_error (p, "M Z is firmly related to M Z",
+			 MOID (s), NSYMBOL (NODE (s)), MOID (t),
+			 NSYMBOL (NODE (t)));
+	    }
+
+	  /* Warn for hidden firmly related operators defined in outer ranges,
+	     if requested.  */
+	  for (TABLE_T *prev = PREVIOUS (TAG_TABLE (s));
+	       prev != NO_TABLE;
+	       prev = PREVIOUS (prev))
+	    {
+	      TAG_T *t = find_firmly_related_op (prev, NSYMBOL (NODE (s)), l, r,
+						 NO_TAG /* self */);
+	      if (t != NO_TAG)
+		{
+		  if (TAG_TABLE (t) == A68_STANDENV)
+		    {
+		      if (a68_warning (p, OPT_Whidden_declarations,
+				       "'M Z' hides a firmly related operator in a larger reach",
+				       MOID (s), NSYMBOL (NODE (s))))
+			{
+			  a68_inform (NO_NODE,
+				      "operator 'M Z' defined in the standard prelude",
+				      MOID (t), NSYMBOL (NODE (t)));
+			}
+		    }
+		  else
+		    {
+		      if (a68_warning (p, OPT_Whidden_declarations,
+				       "'M Z' hides a firmly related operator in a larger reach",
+				       MOID (s), NSYMBOL (NODE (s))))
+			{
+			  a68_inform (NODE (t),
+				      "previous hidden declaration of S declared here",
+				      NSYMBOL (NODE (s)));
+			}
+		    }
+
+		  /* Report only one level of hidding or it gets messy.  */
+		  break;
+		}
+	    }
+	}
+      if (NEXT (s) != NO_TAG)
+	test_firmly_related_ops_local ((p == NO_NODE ? NO_NODE : NODE (NEXT (s))), NEXT (s));
+    }
+}
+
+/* Find firmly related operators in this program.  */
+
+static void
+test_firmly_related_ops (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (SUB (p) != NO_NODE && a68_is_new_lexical_level (p))
+	{
+	  TAG_T *oops = OPERATORS (TABLE (SUB (p)));
+
+	  if (oops != NO_TAG)
+	    test_firmly_related_ops_local (NODE (oops), oops);
+	}
+      test_firmly_related_ops (SUB (p));
+    }
+}
+
+/* Driver for the processing of TAXes.  */
+
+void
+a68_collect_taxes (NODE_T *p)
+{
+  tax_tags (p);
+  tax_specifiers (p);
+  tax_parameters (p);
+  tax_for_identifiers (p);
+  tax_routine_texts (p);
+  tax_pictures (p);
+  tax_format_texts (p);
+  tax_generators (p);
+  bind_identifier_tag_to_symbol_table (p);
+  bind_indicant_tag_to_symbol_table (p);
+  test_firmly_related_ops (p);
+  test_firmly_related_ops_local (NO_NODE, OPERATORS (A68_STANDENV));
+}
+
+/* Whether tag has already been declared in this range.  */
+
+static void
+already_declared (NODE_T *n, int a)
+{
+  if (find_tag_local (TABLE (n), a, NSYMBOL (n)) != NO_TAG)
+    a68_error (n, "multiple declaration of tag S");
+}
+
+/* Whether tag has already been declared in this range.  */
+
+static void
+already_declared_hidden (NODE_T *n, int a)
+{
+  if (find_tag_local (TABLE (n), a, NSYMBOL (n)) != NO_TAG)
+    a68_error (n, "multiple declaration of tag S");
+
+  TAG_T *s = a68_find_tag_global (PREVIOUS (TABLE (n)), a, NSYMBOL (n));
+  if (s != NO_TAG)
+    {
+      if (TAG_TABLE (s) == A68_STANDENV)
+	{
+	  a68_warning (n, OPT_Whidden_declarations,
+		       "declaration hides prelude declaration of M S",
+		       MOID (s), NSYMBOL (n));
+	}
+      else
+	{
+	  if (a68_warning (n, OPT_Whidden_declarations,
+			   "declaration hides a declaration of S with larger reach",
+			   NSYMBOL (n)))
+	    {
+	      a68_inform (NO_NODE,
+			  "previous hidden declaration of S declared here",
+			  NSYMBOL (n));
+	    }
+	}
+    }
+}
+
+/* Add tag to local symbol table.  */
+
+TAG_T *
+a68_add_tag (TABLE_T *s, int a, NODE_T *n, MOID_T *m, int p)
+{
+#define INSERT_TAG(l, n) {NEXT (n) = *(l); *(l) = (n);}
+  if (s != NO_TABLE)
+    {
+      TAG_T *z = a68_new_tag ();
+
+      TAG_TABLE (z) = s;
+      PRIO (z) = p;
+      MOID (z) = m;
+      NODE (z) = n;
+      /* TAX(n) = z;.  */
+      switch (a)
+	{
+	case IDENTIFIER:
+	  already_declared_hidden (n, IDENTIFIER);
+	  already_declared_hidden (n, LABEL);
+	  INSERT_TAG (&IDENTIFIERS (s), z);
+	  break;
+	case INDICANT:
+	  already_declared_hidden (n, INDICANT);
+	  already_declared (n, OP_SYMBOL);
+	  already_declared (n, PRIO_SYMBOL);
+	  INSERT_TAG (&INDICANTS (s), z);
+	  break;
+	case LABEL:
+	  already_declared_hidden (n, LABEL);
+	  already_declared_hidden (n, IDENTIFIER);
+	  INSERT_TAG (&LABELS (s), z);
+	  break;
+	case OP_SYMBOL:
+	  already_declared (n, INDICANT);
+	  INSERT_TAG (&OPERATORS (s), z);
+	  break;
+	case PRIO_SYMBOL:
+	  already_declared (n, PRIO_SYMBOL);
+	  already_declared (n, INDICANT);
+	  INSERT_TAG (&PRIO (s), z);
+	  break;
+	case ANONYMOUS:
+	  INSERT_TAG (&ANONYMOUS (s), z);
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+      return z;
+    }
+  else
+    return NO_TAG;
+}
+
+/* Find a tag, searching symbol tables towards the root.  */
+
+TAG_T *
+a68_find_tag_global (TABLE_T *table, int a, const char *name)
+{
+  if (table != NO_TABLE)
+    {
+      TAG_T *s = NO_TAG;
+      switch (a)
+	{
+	case IDENTIFIER:
+	  s = IDENTIFIERS (table);
+	  break;
+	case INDICANT:
+	  s = INDICANTS (table);
+	  break;
+	case LABEL:
+	  s = LABELS (table);
+	  break;
+	case OP_SYMBOL:
+	  s = OPERATORS (table);
+	  break;
+	case PRIO_SYMBOL:
+	  s = PRIO (table);
+	  break;
+	default:
+	  gcc_unreachable ();
+	  break;
+	}
+      
+      for (; s != NO_TAG; FORWARD (s))
+	{
+	  if (NSYMBOL (NODE (s)) == name)
+	    return s;
+	}
+      return a68_find_tag_global (PREVIOUS (table), a, name);
+    }
+  else
+    return NO_TAG;
+}
+
+/* Whether identifier or label global.  */
+
+int
+a68_is_identifier_or_label_global (TABLE_T *table, const char *name)
+{
+  if (table != NO_TABLE)
+    {
+      for (TAG_T *s = IDENTIFIERS (table); s != NO_TAG; FORWARD (s))
+	{
+	  if (NSYMBOL (NODE (s)) == name)
+	    return IDENTIFIER;
+	}
+      for (TAG_T *s = LABELS (table); s != NO_TAG; FORWARD (s))
+	{
+	  if (NSYMBOL (NODE (s)) == name)
+	    return LABEL;
+	}
+      return a68_is_identifier_or_label_global (PREVIOUS (table), name);
+    }
+  else
+    return 0;
+}
+
+/* Find a tag, searching only local symbol table.  */
+
+static TAG_T *
+find_tag_local (TABLE_T *table, int a, const char *name)
+{
+  if (table != NO_TABLE)
+    {
+      TAG_T *s = NO_TAG;
+
+      if (a == OP_SYMBOL)
+	s = OPERATORS (table);
+      else if (a == PRIO_SYMBOL)
+	s = PRIO (table);
+      else if (a == IDENTIFIER)
+	s = IDENTIFIERS (table);
+      else if (a == INDICANT)
+	s = INDICANTS (table);
+      else if (a == LABEL)
+	s = LABELS (table);
+      else
+	gcc_unreachable ();
+
+    for (; s != NO_TAG; FORWARD (s))
+      {
+	if (NSYMBOL (NODE (s)) == name)
+	  return s;
+      }
+    }
+  return NO_TAG;
+}
+
+/* Whether context specifies HEAP or LOC for an identifier.  */
+
+static int
+tab_qualifier (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (a68_is_one_of (p, UNIT, ASSIGNATION, TERTIARY, SECONDARY, GENERATOR, STOP))
+	return tab_qualifier (SUB (p));
+      else if (a68_is_one_of (p, LOC_SYMBOL, HEAP_SYMBOL, STOP))
+	return ATTRIBUTE (p) == LOC_SYMBOL ? LOC_SYMBOL : HEAP_SYMBOL;
+      else
+	return LOC_SYMBOL;
+    }
+  else
+    return LOC_SYMBOL;
+}
+
+/* Enter identity declarations in the symbol table.  */
+
+static void
+tax_identity_dec (NODE_T *p, MOID_T **m)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, IDENTITY_DECLARATION))
+	{
+	  tax_identity_dec (SUB (p), m);
+	  tax_identity_dec (NEXT (p), m);
+	}
+      else if (IS (p, DECLARER))
+	{
+	  tax_tags (SUB (p));
+	  *m = MOID (p);
+	  tax_identity_dec (NEXT (p), m);
+	}
+      else if (IS (p, COMMA_SYMBOL))
+	{
+	  tax_identity_dec (NEXT (p), m);
+	}
+      else if (IS (p, DEFINING_IDENTIFIER))
+	{
+	  TAG_T *entry = find_tag_local (TABLE (p), IDENTIFIER, NSYMBOL (p));
+
+	  MOID (p) = *m;
+	  HEAP (entry) = LOC_SYMBOL;
+	  TAX (p) = entry;
+	  MOID (entry) = *m;
+	  if (ATTRIBUTE (*m) == REF_SYMBOL)
+	    HEAP (entry) = tab_qualifier (NEXT_NEXT (p));
+	  tax_identity_dec (NEXT_NEXT (p), m);
+	}
+      else
+	tax_tags (p);
+    }
+}
+
+/* Enter variable declarations in the symbol table.  */
+
+static void
+tax_variable_dec (NODE_T *p, int *q, MOID_T **m)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, VARIABLE_DECLARATION))
+	{
+	  tax_variable_dec (SUB (p), q, m);
+	  tax_variable_dec (NEXT (p), q, m);
+	}
+      else if (IS (p, DECLARER))
+	{
+	  tax_tags (SUB (p));
+	  *m = MOID (p);
+	  tax_variable_dec (NEXT (p), q, m);
+	}
+      else if (IS (p, QUALIFIER))
+	{
+	  *q = ATTRIBUTE (SUB (p));
+	  tax_variable_dec (NEXT (p), q, m);
+	}
+      else if (IS (p, COMMA_SYMBOL))
+	{
+	  tax_variable_dec (NEXT (p), q, m);
+	}
+      else if (IS (p, DEFINING_IDENTIFIER))
+	{
+	  TAG_T *entry = find_tag_local (TABLE (p), IDENTIFIER, NSYMBOL (p));
+
+	  MOID (p) = *m;
+	  TAX (p) = entry;
+	  HEAP (entry) = *q;
+	  if (*q == LOC_SYMBOL)
+	    {
+	      TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, SUB (*m), GENERATOR);
+	      HEAP (z) = LOC_SYMBOL;
+	      USE (z) = true;
+	      BODY (entry) = z;
+	    }
+	  else
+	    {
+	      BODY (entry) = NO_TAG;
+	    }
+	  MOID (entry) = *m;
+	  tax_variable_dec (NEXT (p), q, m);
+	}
+      else
+	tax_tags (p);
+    }
+}
+
+/* Enter procedure variable declarations in the symbol table.  */
+
+static void
+tax_proc_variable_dec (NODE_T *p, int *q)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, PROCEDURE_VARIABLE_DECLARATION))
+	{
+	  tax_proc_variable_dec (SUB (p), q);
+	  tax_proc_variable_dec (NEXT (p), q);
+	}
+      else if (IS (p, QUALIFIER))
+	{
+	  *q = ATTRIBUTE (SUB (p));
+	  tax_proc_variable_dec (NEXT (p), q);
+	}
+      else if (a68_is_one_of (p, PROC_SYMBOL, COMMA_SYMBOL, STOP))
+	{
+	  tax_proc_variable_dec (NEXT (p), q);
+	}
+      else if (IS (p, DEFINING_IDENTIFIER))
+	{
+	  TAG_T *entry = find_tag_local (TABLE (p), IDENTIFIER, NSYMBOL (p));
+
+	  TAX (p) = entry;
+	  HEAP (entry) = *q;
+	  MOID (entry) = MOID (p);
+	  if (*q == LOC_SYMBOL)
+	    {
+	      TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, SUB_MOID (p), GENERATOR);
+	      HEAP (z) = LOC_SYMBOL;
+	      USE (z) = true;
+	      BODY (entry) = z;
+	    }
+	  else
+	    {
+	      BODY (entry) = NO_TAG;
+	    }
+	  tax_proc_variable_dec (NEXT (p), q);
+	}
+      else
+	tax_tags (p);
+    }
+}
+
+/* Enter procedure declarations in the symbol table.  */
+
+static void
+tax_proc_dec (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, PROCEDURE_DECLARATION))
+	{
+	  tax_proc_dec (SUB (p));
+	  tax_proc_dec (NEXT (p));
+	}
+      else if (a68_is_one_of (p, PROC_SYMBOL, COMMA_SYMBOL, STOP))
+	{
+	  tax_proc_dec (NEXT (p));
+	}
+      else if (IS (p, DEFINING_IDENTIFIER))
+	{
+	  TAG_T *entry = find_tag_local (TABLE (p), IDENTIFIER, NSYMBOL (p));
+
+	  MOID_T *m = MOID (NEXT_NEXT (p));
+	  MOID (p) = m;
+	  TAX (p) = entry;
+	  HEAP (entry) = LOC_SYMBOL;
+	  MOID (entry) = m;
+	  tax_proc_dec (NEXT (p));
+	}
+      else
+	tax_tags (p);
+    }
+}
+
+/* Check validity of operator declaration.  */
+
+static void
+check_operator_dec (NODE_T *p, MOID_T *u)
+{
+  int k = 0;
+
+  if (u == NO_MOID)
+    {
+      NODE_T *pack = SUB_SUB (NEXT_NEXT (p)); /* Where the parameter pack
+						 is.  */
+      if (ATTRIBUTE (NEXT_NEXT (p)) != ROUTINE_TEXT)
+	pack = SUB (pack);
+      k = 1 + a68_count_operands (pack);
+    }
+  else
+    k = a68_count_pack_members (PACK (u));
+
+  if (k < 1 || k > 2)
+    {
+      a68_error (p, "incorrect number of operands for S");
+      k = 0;
+    }
+
+  if (k == 1 && strchr (NOMADS, NSYMBOL (p)[0]) != NO_TEXT)
+    {
+      a68_error (p, "monadic S cannot start with a character from Z", NOMADS);
+    }
+  else if (k == 2 && !a68_find_tag_global (TABLE (p), PRIO_SYMBOL, NSYMBOL (p)))
+    {
+      a68_error (p, "dyadic S has no priority declaration");
+    }
+}
+
+/* Enter operator declarations in the symbol table.  */
+
+static void
+tax_op_dec (NODE_T *p, MOID_T **m)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, OPERATOR_DECLARATION))
+	{
+	  tax_op_dec (SUB (p), m);
+	  tax_op_dec (NEXT (p), m);
+	}
+      else if (IS (p, OPERATOR_PLAN))
+	{
+	  tax_tags (SUB (p));
+	  *m = MOID (p);
+	  tax_op_dec (NEXT (p), m);
+	}
+      else if (IS (p, OP_SYMBOL))
+	{
+	  tax_op_dec (NEXT (p), m);
+	}
+      else if (IS (p, COMMA_SYMBOL))
+	{
+	  tax_op_dec (NEXT (p), m);
+	}
+      else if (IS (p, DEFINING_OPERATOR))
+	{
+	  TAG_T *entry = OPERATORS (TABLE (p));
+	  check_operator_dec (p, *m);
+	  while (entry != NO_TAG && NODE (entry) != p)
+	    FORWARD (entry);
+	  MOID (p) = *m;
+	  TAX (p) = entry;
+	  HEAP (entry) = LOC_SYMBOL;
+	  MOID (entry) = *m;
+	  tax_op_dec (NEXT (p), m);
+	}
+      else
+	{
+	  tax_tags (p);
+	}
+    }
+}
+
+/* Enter brief operator declarations in the symbol table.  */
+
+static void
+tax_brief_op_dec (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, BRIEF_OPERATOR_DECLARATION))
+	{
+	  tax_brief_op_dec (SUB (p));
+	  tax_brief_op_dec (NEXT (p));
+	}
+      else if (a68_is_one_of (p, OP_SYMBOL, COMMA_SYMBOL, STOP))
+	{
+	  tax_brief_op_dec (NEXT (p));
+	}
+      else if (IS (p, DEFINING_OPERATOR))
+	{
+	  TAG_T *entry = OPERATORS (TABLE (p));
+	  MOID_T *m = MOID (NEXT_NEXT (p));
+	  check_operator_dec (p, NO_MOID);
+	  while (entry != NO_TAG && NODE (entry) != p)
+	    FORWARD (entry);
+	  MOID (p) = m;
+	  TAX (p) = entry;
+	  HEAP (entry) = LOC_SYMBOL;
+	  MOID (entry) = m;
+	  tax_brief_op_dec (NEXT (p));
+	}
+      else
+	{
+	  tax_tags (p);
+	}
+    }
+}
+
+/* Enter priority declarations in the symbol table.  */
+
+static void tax_prio_dec (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, PRIORITY_DECLARATION))
+	{
+	  tax_prio_dec (SUB (p));
+	  tax_prio_dec (NEXT (p));
+	}
+      else if (a68_is_one_of (p, PRIO_SYMBOL, COMMA_SYMBOL, STOP))
+	{
+	  tax_prio_dec (NEXT (p));
+	}
+      else if (IS (p, DEFINING_OPERATOR))
+	{
+	  TAG_T *entry = PRIO (TABLE (p));
+	  while (entry != NO_TAG && NODE (entry) != p)
+	    FORWARD (entry);
+	  MOID (p) = NO_MOID;
+	  TAX (p) = entry;
+	  HEAP (entry) = LOC_SYMBOL;
+	  tax_prio_dec (NEXT (p));
+	}
+      else
+	{
+	  tax_tags (p);
+	}
+    }
+}
+
+/* Enter TAXes in the symbol table.  */
+
+static void
+tax_tags (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      int heap = LOC_SYMBOL;
+      MOID_T *m = NO_MOID;
+
+      if (IS (p, IDENTITY_DECLARATION))
+	tax_identity_dec (p, &m);
+      else if (IS (p, VARIABLE_DECLARATION))
+	tax_variable_dec (p, &heap, &m);
+      else if (IS (p, PROCEDURE_DECLARATION))
+	tax_proc_dec (p);
+      else if (IS (p, PROCEDURE_VARIABLE_DECLARATION))
+	tax_proc_variable_dec (p, &heap);
+      else if (IS (p, OPERATOR_DECLARATION))
+	tax_op_dec (p, &m);
+      else if (IS (p, BRIEF_OPERATOR_DECLARATION))
+	tax_brief_op_dec (p);
+      else if (IS (p, PRIORITY_DECLARATION))
+	tax_prio_dec (p);
+      else
+      tax_tags (SUB (p));
+    }
+}
+
+/* Reset symbol table nest count.  */
+
+void
+a68_reset_symbol_table_nest_count (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (SUB (p) != NO_NODE && a68_is_new_lexical_level (p))
+	NEST (TABLE (SUB (p))) = A68 (symbol_table_count)++;
+      a68_reset_symbol_table_nest_count (SUB (p));
+    }
+}
+
+//! @brief Bind routines in symbol table to the tree.
+
+void
+a68_bind_routine_tags_to_tree (NODE_T *p)
+{
+  /* By inserting coercions etc. some may have shifted.  */
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, ROUTINE_TEXT) && TAX (p) != NO_TAG)
+	NODE (TAX (p)) = p;
+      a68_bind_routine_tags_to_tree (SUB (p));
+    }
+}
+
+/* Bind formats in symbol table to tree.  */
+
+static void
+bind_format_tags_to_tree (NODE_T *p)
+{
+  /* By inserting coercions etc. some may have shifted.  */
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, FORMAT_TEXT) && TAX (p) != NO_TAG)
+	NODE (TAX (p)) = p;
+      else if (IS (p, FORMAT_DELIMITER_SYMBOL) && NEXT (p) != NO_NODE && TAX (p) != NO_TAG)
+	NODE (TAX (p)) = p;
+
+      bind_format_tags_to_tree (SUB (p));
+    }
+}
+
+/* Fill outer level of symbol table.  */
+
+void
+a68_fill_symbol_table_outer (NODE_T *p, TABLE_T *s)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (TABLE (p) != NO_TABLE)
+	OUTER (TABLE (p)) = s;
+
+      if (SUB (p) != NO_NODE && IS (p, ROUTINE_TEXT))
+	a68_fill_symbol_table_outer (SUB (p), TABLE (SUB (p)));
+      else if (SUB (p) != NO_NODE && IS (p, FORMAT_TEXT))
+	a68_fill_symbol_table_outer (SUB (p), TABLE (SUB (p)));
+      else
+	a68_fill_symbol_table_outer (SUB (p), s);
+    }
+}
+
+/* Flood branch in tree with local symbol table S.  */
+
+static void
+flood_with_symbol_table_restricted (NODE_T *p, TABLE_T *s)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      TABLE (p) = s;
+      if (ATTRIBUTE (p) != ROUTINE_TEXT && ATTRIBUTE (p) != SPECIFIED_UNIT)
+	{
+	  if (a68_is_new_lexical_level (p))
+	    PREVIOUS (TABLE (SUB (p))) = s;
+	  else
+	    flood_with_symbol_table_restricted (SUB (p), s);
+	}
+    }
+}
+
+/* Final structure of symbol table after parsing.  */
+
+void
+a68_finalise_symbol_table_setup (NODE_T *p, int l)
+{
+  TABLE_T *s = TABLE (p);
+  NODE_T *q = p;
+
+  while (q != NO_NODE)
+    {
+      /* routine texts are ranges.  */
+      if (IS (q, ROUTINE_TEXT))
+	flood_with_symbol_table_restricted (SUB (q), a68_new_symbol_table (s));
+
+      /* specifiers are ranges.  */
+      else if (IS (q, SPECIFIED_UNIT))
+	flood_with_symbol_table_restricted (SUB (q), a68_new_symbol_table (s));
+
+      /* level count and recursion.  */
+      if (SUB (q) != NO_NODE)
+	{
+	  if (a68_is_new_lexical_level (q))
+	    {
+	      LEX_LEVEL (SUB (q)) = l + 1;
+	      PREVIOUS (TABLE (SUB (q))) = s;
+	      a68_finalise_symbol_table_setup (SUB (q), l + 1);
+	      if (IS (q, WHILE_PART))
+		{
+		  /* This was a bug that went unnoticed for 15 years!.  */
+		  TABLE_T *s2 = TABLE (SUB (q));
+		  if ((FORWARD (q)) == NO_NODE)
+		    return;
+		  if (IS (q, ALT_DO_PART))
+		    {
+		      PREVIOUS (TABLE (SUB (q))) = s2;
+		      LEX_LEVEL (SUB (q)) = l + 2;
+		      a68_finalise_symbol_table_setup (SUB (q), l + 2);
+		    }
+		}
+	    }
+	  else
+	    {
+	      TABLE (SUB (q)) = s;
+	      a68_finalise_symbol_table_setup (SUB (q), l);
+	    }
+	}
+      TABLE (q) = s;
+
+      if (IS (q, FOR_SYMBOL))
+	FORWARD (q);
+      FORWARD (q);
+    }
+
+  /* FOR identifiers are in the DO ... OD range.  */
+  for (q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (IS (q, FOR_SYMBOL))
+	TABLE (NEXT (q)) = TABLE (SEQUENCE (NEXT (q)));
+    }
+}
+
+/* First structure of symbol table for parsing.  */
+
+void
+a68_preliminary_symbol_table_setup (NODE_T *p)
+{
+  TABLE_T *s = TABLE (p);
+  bool not_a_for_range = false;
+
+  /* Let the tree point to the current symbol table.  */
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    TABLE (q) = s;
+
+  /* insert new tables when required.  */
+  for (NODE_T *q = p; q != NO_NODE && !not_a_for_range; FORWARD (q))
+    {
+      if (SUB (q) != NO_NODE)
+	{
+	  /* BEGIN ... END, CODE ... EDOC, DEF ... FED, DO ... OD, $ ... $,
+	     { ... } are ranges.  */
+	  if (a68_is_one_of (q, BEGIN_SYMBOL, DO_SYMBOL, ALT_DO_SYMBOL,
+			     FORMAT_DELIMITER_SYMBOL, STOP))
+	    {
+	      TABLE (SUB (q)) = a68_new_symbol_table (s);
+	      a68_preliminary_symbol_table_setup (SUB (q));
+	    }
+	  /* ( ... ) is a range.   */
+	  else if (IS (q, OPEN_SYMBOL))
+	    {
+	      if (a68_whether (q, OPEN_SYMBOL, THEN_BAR_SYMBOL, STOP))
+		{
+		  TABLE (SUB (q)) = s;
+		  a68_preliminary_symbol_table_setup (SUB (q));
+		  FORWARD (q);
+		  TABLE (SUB (q)) = a68_new_symbol_table (s);
+		  a68_preliminary_symbol_table_setup (SUB (q));
+		  if ((FORWARD (q)) == NO_NODE)
+		    not_a_for_range = true;
+		  else
+		    {
+		      if (IS (q, THEN_BAR_SYMBOL))
+			{
+			  TABLE (SUB (q)) = a68_new_symbol_table (s);
+			  a68_preliminary_symbol_table_setup (SUB (q));
+			}
+		      if (IS (q, OPEN_SYMBOL))
+			{
+			  TABLE (SUB (q)) = a68_new_symbol_table (s);
+			  a68_preliminary_symbol_table_setup (SUB (q));
+			}
+		    }
+		}
+	      else
+		{
+		  /* Don't worry about STRUCT (...), UNION (...), PROC (...)
+		     yet.  */
+		  TABLE (SUB (q)) = a68_new_symbol_table (s);
+		  a68_preliminary_symbol_table_setup (SUB (q));
+		}
+	    }
+	  /* IF ... THEN ... ELSE ... FI are ranges.  */
+	  else if (IS (q, IF_SYMBOL))
+	    {
+	      if (a68_whether (q, IF_SYMBOL, THEN_SYMBOL, STOP))
+		{
+		  TABLE (SUB (q)) = s;
+		  a68_preliminary_symbol_table_setup (SUB (q));
+		  FORWARD (q);
+		  TABLE (SUB (q)) = a68_new_symbol_table (s);
+		  a68_preliminary_symbol_table_setup (SUB (q));
+		  if ((FORWARD (q)) == NO_NODE)
+		    not_a_for_range = true;
+		  else
+		    if (IS (q, ELSE_SYMBOL))
+		      {
+			TABLE (SUB (q)) = a68_new_symbol_table (s);
+			a68_preliminary_symbol_table_setup (SUB (q));
+		      }
+		  if (IS (q, IF_SYMBOL))
+		    {
+		      TABLE (SUB (q)) = a68_new_symbol_table (s);
+		      a68_preliminary_symbol_table_setup (SUB (q));
+		    }
+		}
+	      else
+		{
+		  TABLE (SUB (q)) = a68_new_symbol_table (s);
+		  a68_preliminary_symbol_table_setup (SUB (q));
+		}
+	    }
+	  /* CASE ... IN ... OUT ... ESAC are ranges.  */
+	  else if (IS (q, CASE_SYMBOL))
+	    {
+	      if (a68_whether (q, CASE_SYMBOL, IN_SYMBOL, STOP))
+		{
+		  TABLE (SUB (q)) = s;
+		  a68_preliminary_symbol_table_setup (SUB (q));
+		  FORWARD (q);
+		  TABLE (SUB (q)) = a68_new_symbol_table (s);
+		  a68_preliminary_symbol_table_setup (SUB (q));
+		  if ((FORWARD (q)) == NO_NODE)
+		    not_a_for_range = true;
+		  else
+		    {
+		      if (IS (q, OUT_SYMBOL))
+			{
+			  TABLE (SUB (q)) = a68_new_symbol_table (s);
+			  a68_preliminary_symbol_table_setup (SUB (q));
+			}
+		      if (IS (q, CASE_SYMBOL))
+			{
+			  TABLE (SUB (q)) = a68_new_symbol_table (s);
+			  a68_preliminary_symbol_table_setup (SUB (q));
+			}
+		    }
+		}
+	      else
+		{
+		  TABLE (SUB (q)) = a68_new_symbol_table (s);
+		  a68_preliminary_symbol_table_setup (SUB (q));
+		}
+	    }
+	  /* WHILE ... DO ... OD are ranges.  */
+	  else if (IS (q, WHILE_SYMBOL))
+	    {
+	      TABLE_T *u = a68_new_symbol_table (s);
+	      TABLE (SUB (q)) = u;
+	      a68_preliminary_symbol_table_setup (SUB (q));
+	      if ((FORWARD (q)) == NO_NODE)
+		not_a_for_range = true;
+	      else if (IS (q, ALT_DO_SYMBOL))
+		{
+		  TABLE (SUB (q)) = a68_new_symbol_table (u);
+		  a68_preliminary_symbol_table_setup (SUB (q));
+		}
+	    }
+	  else
+	    {
+	      TABLE (SUB (q)) = s;
+	      a68_preliminary_symbol_table_setup (SUB (q));
+	    }
+	}
+    }
+  /* FOR identifiers will go to the DO ... OD range.  */
+  if (!not_a_for_range)
+    {
+      for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+	{
+	  if (IS (q, FOR_SYMBOL))
+	    {
+	      NODE_T *r = q;
+	      TABLE (NEXT (q)) = NO_TABLE;
+	      for (; r != NO_NODE && TABLE (NEXT (q)) == NO_TABLE; FORWARD (r))
+		{
+		  if ((a68_is_one_of (r, WHILE_SYMBOL, ALT_DO_SYMBOL, STOP))
+		      && (NEXT (q) != NO_NODE && SUB (r) != NO_NODE))
+		    {
+		      TABLE (NEXT (q)) = TABLE (SUB (r));
+		      SEQUENCE (NEXT (q)) = SUB (r);
+		    }
+		}
+	    }
+	}
+    }
+}
+
+/* Mark a mode as in use.  */
+
+static void
+mark_mode (MOID_T *m)
+{
+  if (m != NO_MOID && USE (m) == false)
+    {
+      PACK_T *p = PACK (m);
+      USE (m) = true;
+      for (; p != NO_PACK; FORWARD (p))
+	{
+	  mark_mode (MOID (p));
+	  mark_mode (SUB (m));
+	  mark_mode (SLICE (m));
+	}
+    }
+}
+
+//! @brief Traverse tree and mark modes as used.
+
+void
+a68_mark_moids (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      a68_mark_moids (SUB (p));
+      if (MOID (p) != NO_MOID)
+	mark_mode (MOID (p));
+    }
+}
+
+/* Mark various tags as used.  */
+
+void
+a68_mark_auxilliary (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (SUB (p) != NO_NODE)
+	{
+	  /* You get no warnings on unused PROC parameters. That is ok since
+	     A68 has some parameters that you may not use at all - think of
+	     PROC (REF FILE) BOOL event routines in transput.  */
+	  a68_mark_auxilliary (SUB (p));
+	}
+      else if (IS (p, OPERATOR))
+	{
+	  TAG_T *z;
+
+	  if (TAX (p) != NO_TAG)
+	    USE (TAX (p)) = true;
+	  
+	  if ((z = a68_find_tag_global (TABLE (p), PRIO_SYMBOL, NSYMBOL (p))) != NO_TAG)
+	    USE (z) = true;
+	}
+      else if (IS (p, INDICANT))
+	{
+	  TAG_T *z = a68_find_tag_global (TABLE (p), INDICANT, NSYMBOL (p));
+
+	  if (z != NO_TAG)
+	    {
+	      TAX (p) = z;
+	      USE (z) = true;
+	    }
+	}
+      else if (IS (p, IDENTIFIER))
+	{
+	  if (TAX (p) != NO_TAG)
+	    USE (TAX (p)) = true;
+	}
+    }
+}
+
+/* Check a single tag.  */
+
+static void
+unused (TAG_T *s)
+{
+  for (; s != NO_TAG; FORWARD (s))
+    {
+      if (LINE_NUMBER (NODE (s)) > 0 && !USE (s))
+	a68_warning (NODE (s), OPT_Wunused, "tag S is not used", NODE (s));
+    }
+}
+
+/* Driver for traversing tree and warn for unused tags.  */
+
+void
+a68_warn_for_unused_tags (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (SUB (p) != NO_NODE)
+	{
+	  if (a68_is_new_lexical_level (p))
+	    {
+	      unused (OPERATORS (TABLE (SUB (p))));
+	      unused (PRIO (TABLE (SUB (p))));
+	      unused (IDENTIFIERS (TABLE (SUB (p))));
+	      unused (LABELS (TABLE (SUB (p))));
+	      unused (INDICANTS (TABLE (SUB (p))));
+	    }
+	}
+      a68_warn_for_unused_tags (SUB (p));
+    }
+}
+
+/* Mark jumps and procedured jumps.  */
+
+void
+a68_jumps_from_procs (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, PROCEDURING))
+	{
+	  NODE_T *u = SUB_SUB (p);
+
+	  if (IS (u, GOTO_SYMBOL))
+	    FORWARD (u);
+	  USE (TAX (u)) = true;
+	}
+      else if (IS (p, JUMP))
+	{
+	  NODE_T *u = SUB (p);
+
+	  if (IS (u, GOTO_SYMBOL))
+	    FORWARD (u);
+	  if ((TAX (u) == NO_TAG) && (MOID (u) == NO_MOID)
+	      && (a68_find_tag_global (TABLE (u), LABEL, NSYMBOL (u)) == NO_TAG))
+	    {
+	      (void) a68_add_tag (TABLE (u), LABEL, u, NO_MOID, LOCAL_LABEL);
+	      a68_error (u, "tag S has not been declared properly");
+	    }
+	  else
+	    USE (TAX (u)) = true;
+	}
+      else
+	a68_jumps_from_procs (SUB (p));
+    }
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-top-down.cc
@@ -0,0 +1,785 @@
+/* Top-down parser for control structure.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "a68.h"
+
+/* A few forward prototypes of functions defined below.  */
+
+static NODE_T *top_down_loop (NODE_T *p);
+static NODE_T *top_down_skip_unit (NODE_T *p);
+
+/* Substitute brackets.
+
+   Traditional ALGOL 68 syntax allows ( .. ) to replace [ .. ] in bounds and
+   slices.  This top-down pass substitutes [ .. ] occurrences into ( .. ).  */
+
+void
+a68_substitute_brackets (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      a68_substitute_brackets (SUB (p));
+
+      switch (ATTRIBUTE (p))
+	{
+	case SUB_SYMBOL:
+	  ATTRIBUTE (p) = OPEN_SYMBOL;
+	  break;
+	case BUS_SYMBOL:
+	  ATTRIBUTE (p) = CLOSE_SYMBOL;
+	  break;
+	default:
+	  break;
+	}
+    }
+}
+
+/* Intelligible diagnostic from syntax tree branch.  */
+
+char *
+a68_phrase_to_text (NODE_T * p, NODE_T ** w)
+{
+#define MAX_TERMINALS 8
+  int count = 0, line = -1;
+  static BUFFER buffer;
+
+  for (buffer[0] = '\0'; p != NO_NODE && count < MAX_TERMINALS; FORWARD (p))
+    {
+      if (LINE_NUMBER (p) == 0)
+	continue;
+
+      enum a68_attribute gatt = a68_get_good_attribute (p);
+      const char *z = a68_attribute_name (gatt);
+
+      /* Where to put the error message? Bob Uzgalis noted that actual
+	 content of a diagnostic is not as important as accurately
+	 indicating *were* the problem is!  */
+      if (w != NO_VAR)
+	{
+	  if (count == 0 || (*w) == NO_NODE)
+	    *w = p;
+	  else if (a68_dont_mark_here (*w))
+	    *w = p;
+	}
+
+      /* Add initiation.  */
+      if (count == 0)
+	{
+	  if (w != NO_VAR)
+	    a68_bufcat (buffer, "construct beginning with", BUFFER_SIZE);
+	}
+      else if (count == 1)
+	a68_bufcat (buffer, " followed by", BUFFER_SIZE);
+      else if (count == 2)
+	a68_bufcat (buffer, " and then", BUFFER_SIZE);
+      else if (count >= 3)
+	a68_bufcat (buffer, " and", BUFFER_SIZE);
+
+      /* Attribute or symbol.  */
+      if (z != NO_TEXT && SUB (p) != NO_NODE)
+	{
+	  if (gatt == IDENTIFIER || gatt == OPERATOR || gatt == DENOTATION)
+	    {
+	      if (snprintf (A68 (edit_line), SNPRINTF_SIZE, " \"%s\"", NSYMBOL (p)) < 0)
+		gcc_unreachable ();
+	      a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
+	    }
+	  else
+	    {
+	      if (strchr ("aeio", z[0]) != NO_TEXT)
+		a68_bufcat (buffer, " an", BUFFER_SIZE);
+	      else
+		a68_bufcat (buffer, " a", BUFFER_SIZE);
+
+	      if (snprintf (A68 (edit_line), SNPRINTF_SIZE, " %s", z) < 0)
+		gcc_unreachable ();
+	      a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
+	    }
+	}
+      else if (z != NO_TEXT && SUB (p) == NO_NODE)
+	{
+	  if (snprintf (A68 (edit_line), SNPRINTF_SIZE, " \"%s\"", NSYMBOL (p)) < 0)
+	    gcc_unreachable ();
+	  a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
+	}
+      else if (NSYMBOL (p) != NO_TEXT)
+	{
+	  if (snprintf (A68 (edit_line), SNPRINTF_SIZE, " \"%s\"", NSYMBOL (p)) < 0)
+	    gcc_unreachable ();
+	  a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
+	}
+      /* Add "starting in line nn".  */
+      if (z != NO_TEXT && line != LINE_NUMBER (p))
+	{
+	  line = LINE_NUMBER (p);
+	  if (gatt == SERIAL_CLAUSE || gatt == ENQUIRY_CLAUSE || gatt == INITIALISER_SERIES)
+	    a68_bufcat (buffer, " starting", BUFFER_SIZE);
+	  if (snprintf (A68 (edit_line), SNPRINTF_SIZE, " in line %d", line) < 0)
+	    gcc_unreachable ();
+	  a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE);
+	}
+      count++;
+    }
+
+  if (p != NO_NODE && count == MAX_TERMINALS)
+    a68_bufcat (buffer, " etcetera", BUFFER_SIZE);
+  return buffer;
+}
+
+/* Next is a top-down parser that branches out the basic blocks.
+   After this we can assign symbol tables to basic blocks.
+   This renders the two-level grammar LALR.  */
+
+/* Give diagnose from top-down parser.  */
+
+static void
+top_down_diagnose (NODE_T *start, NODE_T *p, int clause, int expected)
+{
+  NODE_T *issue = (p != NO_NODE ? p : start);
+
+  if (expected != 0)
+    a68_error (issue, "B expected in A, near Z L",
+	       expected, clause, NSYMBOL (start), LINE (INFO (start)));
+  else
+    a68_error (issue, "missing or unbalanced keyword in A, near Z L",
+	       clause, NSYMBOL (start), LINE (INFO (start)));
+}
+
+/* Check for premature exhaustion of tokens.  */
+
+static void
+tokens_exhausted (NODE_T *p, NODE_T *q)
+{
+  if (p == NO_NODE)
+    {
+      a68_error (q, "check for missing or unmatched keyword in clause starting at S");
+      longjmp (A68_PARSER (top_down_crash_exit), 1);
+    }
+}
+
+/*
+ * This part specifically branches out loop clauses.
+ */
+
+/* Whether in cast or formula with loop clause.  */
+
+static int
+is_loop_cast_formula (NODE_T *p)
+{
+  /* Accept declarers that can appear in such casts but not much more.  */
+  if (IS (p, VOID_SYMBOL))
+    return 1;
+  else if (IS (p, INT_SYMBOL))
+    return 1;
+  else if (IS_REF (p))
+    return 1;
+  else if (a68_is_one_of (p, OPERATOR, BOLD_TAG, STOP))
+    return 1;
+  else if (a68_whether (p, UNION_SYMBOL, OPEN_SYMBOL, STOP))
+    return 2;
+  else if (a68_is_one_of (p, OPEN_SYMBOL, SUB_SYMBOL, STOP))
+    {
+      int k = 0;
+      for (; p != NO_NODE && (a68_is_one_of (p, OPEN_SYMBOL, SUB_SYMBOL, STOP)); FORWARD (p), k++)
+	;
+      return p != NO_NODE && (a68_whether (p, UNION_SYMBOL, OPEN_SYMBOL, STOP) ? k : 0);
+    }
+  return 0;
+}
+
+/* Skip a unit in a loop clause (FROM u BY u TO u).  */
+
+static NODE_T *
+top_down_skip_loop_unit (NODE_T *p)
+{
+  /* Unit may start with, or consist of, a loop.  */
+  if (a68_is_loop_keyword (p))
+    p = top_down_loop (p);
+
+  /* Skip rest of unit.  */
+  while (p != NO_NODE)
+    {
+      int k = is_loop_cast_formula (p);
+
+      if (k != 0)
+	{
+	  /* operator-cast series ...  */
+	  while (p != NO_NODE && k != 0)
+	    {
+	      while (k != 0)
+		{
+		  FORWARD (p);
+		  k--;
+		}
+	      k = is_loop_cast_formula (p);
+	    }
+
+	  /* ... may be followed by a loop clause.  */
+	  if (a68_is_loop_keyword (p))
+	    p = top_down_loop (p);
+	}
+      else if (a68_is_loop_keyword (p) || IS (p, OD_SYMBOL))
+	/* new loop or end-of-loop.  */
+	return p;
+      else if (IS (p, COLON_SYMBOL))
+	{
+	  FORWARD (p);
+	  /* skip routine header: loop clause.  */
+	  if (p != NO_NODE && a68_is_loop_keyword (p))
+	    p = top_down_loop (p);
+	}
+      else if (a68_is_one_of (p, SEMI_SYMBOL, COMMA_SYMBOL, STOP) || IS (p, EXIT_SYMBOL))
+	/* Statement separators.  */
+	return p;
+      else
+	FORWARD (p);
+    }
+  return NO_NODE;
+}
+
+/* Skip a loop clause.  */
+
+static NODE_T *
+top_down_skip_loop_series (NODE_T *p)
+{
+  bool siga;
+
+  do
+    {
+      p = top_down_skip_loop_unit (p);
+      siga = (p != NO_NODE && (a68_is_one_of (p, SEMI_SYMBOL, EXIT_SYMBOL,
+					      COMMA_SYMBOL, COLON_SYMBOL,
+					      STOP)));
+    if (siga)
+      FORWARD (p);
+    }
+  while (!(p == NO_NODE || !siga));
+
+  return p;
+}
+
+/* Make branch of loop parts.  */
+
+static NODE_T *
+top_down_loop (NODE_T *p)
+{
+  NODE_T *start = p, *q = p;
+
+  if (IS (q, FOR_SYMBOL))
+    {
+      tokens_exhausted (FORWARD (q), start);
+
+      if (IS (q, IDENTIFIER))
+	ATTRIBUTE (q) = DEFINING_IDENTIFIER;
+      else
+	{
+	  top_down_diagnose (start, q, LOOP_CLAUSE, IDENTIFIER);
+	  longjmp (A68_PARSER (top_down_crash_exit), 1);
+	}
+
+      tokens_exhausted (FORWARD (q), start);
+
+      if (a68_is_one_of (q, FROM_SYMBOL, BY_SYMBOL, TO_SYMBOL,
+			 WHILE_SYMBOL, STOP))
+	;
+      else if (IS (q, DO_SYMBOL))
+	ATTRIBUTE (q) = ALT_DO_SYMBOL;
+      else
+	{
+	  top_down_diagnose (start, q, LOOP_CLAUSE, STOP);
+	  longjmp (A68_PARSER (top_down_crash_exit), 1);
+	}
+    }
+
+  if (IS (q, FROM_SYMBOL))
+    {
+      start = q;
+      q = top_down_skip_loop_unit (NEXT (q));
+      tokens_exhausted (q, start);
+      if (a68_is_one_of (q, BY_SYMBOL, TO_SYMBOL, WHILE_SYMBOL, STOP))
+	;
+      else if (IS (q, DO_SYMBOL))
+	ATTRIBUTE (q) = ALT_DO_SYMBOL;
+      else
+	{
+	  top_down_diagnose (start, q, LOOP_CLAUSE, STOP);
+	  longjmp (A68_PARSER (top_down_crash_exit), 1);
+	}
+
+      a68_make_sub (start, PREVIOUS (q), FROM_SYMBOL);
+    }
+
+  if (IS (q, BY_SYMBOL))
+    {
+      start = q;
+      q = top_down_skip_loop_series (NEXT (q));
+      tokens_exhausted (q, start);
+
+      if (a68_is_one_of (q, TO_SYMBOL, WHILE_SYMBOL, STOP))
+	;
+      else if (IS (q, DO_SYMBOL))
+	ATTRIBUTE (q) = ALT_DO_SYMBOL;
+      else
+	{
+	  top_down_diagnose (start, q, LOOP_CLAUSE, STOP);
+	  longjmp (A68_PARSER (top_down_crash_exit), 1);
+	}
+
+      a68_make_sub (start, PREVIOUS (q), BY_SYMBOL);
+    }
+
+  if (a68_is_one_of (q, TO_SYMBOL, STOP))
+    {
+      start = q;
+      q = top_down_skip_loop_series (NEXT (q));
+      tokens_exhausted (q, start);
+
+      if (IS (q, WHILE_SYMBOL))
+	;
+      else if (IS (q, DO_SYMBOL))
+	ATTRIBUTE (q) = ALT_DO_SYMBOL;
+      else
+	{
+	  top_down_diagnose (start, q, LOOP_CLAUSE, STOP);
+	  longjmp (A68_PARSER (top_down_crash_exit), 1);
+	}
+
+      a68_make_sub (start, PREVIOUS (q), TO_SYMBOL);
+    }
+
+  if (IS (q, WHILE_SYMBOL))
+    {
+      start = q;
+      q = top_down_skip_loop_series (NEXT (q));
+      tokens_exhausted (q, start);
+
+      if (IS (q, DO_SYMBOL))
+	ATTRIBUTE (q) = ALT_DO_SYMBOL;
+      else
+	{
+	  top_down_diagnose (start, q, LOOP_CLAUSE, DO_SYMBOL);
+	  longjmp (A68_PARSER (top_down_crash_exit), 1);
+	}
+
+      a68_make_sub (start, PREVIOUS (q), WHILE_SYMBOL);
+    }
+
+  if (a68_is_one_of (q, DO_SYMBOL, ALT_DO_SYMBOL, STOP))
+    {
+      enum a68_attribute k = ATTRIBUTE (q);
+
+      start = q;
+      q = top_down_skip_loop_series (NEXT (q));
+      tokens_exhausted (q, start);
+
+      if (!IS (q, OD_SYMBOL))
+	{
+	  top_down_diagnose (start, q, LOOP_CLAUSE, OD_SYMBOL);
+	  longjmp (A68_PARSER (top_down_crash_exit), 1);
+	}
+
+      a68_make_sub (start, q, k);
+    }
+
+  NODE_T *save = NEXT (start);
+  a68_make_sub (p, start, LOOP_CLAUSE);
+  return save;
+}
+
+/* Driver for making branches of loop parts.  */
+
+static void
+top_down_loops (NODE_T *p)
+{
+  NODE_T *q = p;
+
+  for (; q != NO_NODE; FORWARD (q))
+    {
+      if (SUB (q) != NO_NODE)
+	top_down_loops (SUB (q));
+    }
+
+  q = p;
+  while (q != NO_NODE)
+    {
+      if (a68_is_loop_keyword (q) != STOP)
+	q = top_down_loop (q);
+      else
+	FORWARD (q);
+    }
+}
+
+/*
+ * Branch anything except parts of a loop.
+ */
+
+/* Skip serial/enquiry clause (unit series).  */
+
+static NODE_T *
+top_down_series (NODE_T *p)
+{
+  bool siga = true;
+  while (siga)
+    {
+      siga = false;
+      p = top_down_skip_unit (p);
+      if (p != NO_NODE)
+	{
+	  if (a68_is_one_of (p, SEMI_SYMBOL, EXIT_SYMBOL, COMMA_SYMBOL, STOP))
+	    {
+	      siga = true;
+	      FORWARD (p);
+	    }
+	}
+    }
+  return p;
+}
+
+/* Make branch of BEGIN .. END.  */
+
+static NODE_T *
+top_down_begin (NODE_T *begin_p)
+{
+  NODE_T *end_p = top_down_series (NEXT (begin_p));
+
+  if (end_p == NO_NODE || !IS (end_p, END_SYMBOL))
+    {
+      top_down_diagnose (begin_p, end_p, ENCLOSED_CLAUSE, END_SYMBOL);
+      longjmp (A68_PARSER (top_down_crash_exit), 1);
+      return NO_NODE;
+    }
+  else
+    {
+      a68_make_sub (begin_p, end_p, BEGIN_SYMBOL);
+      return NEXT (begin_p);
+    }
+}
+
+/* Make branch of ( .. ).  */
+
+static NODE_T *
+top_down_open (NODE_T *open_p)
+{
+  NODE_T *then_bar_p = top_down_series (NEXT (open_p)), *elif_bar_p;
+
+  if (then_bar_p != NO_NODE && IS (then_bar_p, CLOSE_SYMBOL))
+    {
+      a68_make_sub (open_p, then_bar_p, OPEN_SYMBOL);
+      return NEXT (open_p);
+    }
+
+  if (then_bar_p == NO_NODE || !IS (then_bar_p, THEN_BAR_SYMBOL))
+    {
+      top_down_diagnose (open_p, then_bar_p, ENCLOSED_CLAUSE, STOP);
+      longjmp (A68_PARSER (top_down_crash_exit), 1);
+    }
+
+  a68_make_sub (open_p, PREVIOUS (then_bar_p), OPEN_SYMBOL);
+  elif_bar_p = top_down_series (NEXT (then_bar_p));
+  if (elif_bar_p != NO_NODE && IS (elif_bar_p, CLOSE_SYMBOL))
+    {
+      a68_make_sub (then_bar_p, PREVIOUS (elif_bar_p), THEN_BAR_SYMBOL);
+      a68_make_sub (open_p, elif_bar_p, OPEN_SYMBOL);
+      return NEXT (open_p);
+    }
+
+  if (elif_bar_p != NO_NODE && IS (elif_bar_p, THEN_BAR_SYMBOL))
+    {
+      NODE_T *close_p = top_down_series (NEXT (elif_bar_p));
+
+      if (close_p == NO_NODE || !IS (close_p, CLOSE_SYMBOL))
+	{
+	  top_down_diagnose (open_p, elif_bar_p, ENCLOSED_CLAUSE, CLOSE_SYMBOL);
+	  longjmp (A68_PARSER (top_down_crash_exit), 1);
+	}
+
+      a68_make_sub (then_bar_p, PREVIOUS (elif_bar_p), THEN_BAR_SYMBOL);
+      a68_make_sub (elif_bar_p, PREVIOUS (close_p), THEN_BAR_SYMBOL);
+      a68_make_sub (open_p, close_p, OPEN_SYMBOL);
+      return NEXT (open_p);
+    }
+
+  if (elif_bar_p != NO_NODE && IS (elif_bar_p, ELSE_BAR_SYMBOL))
+    {
+      NODE_T *close_p = top_down_open (elif_bar_p);
+      a68_make_sub (then_bar_p, PREVIOUS (elif_bar_p), THEN_BAR_SYMBOL);
+      a68_make_sub (open_p, elif_bar_p, OPEN_SYMBOL);
+      return close_p;
+    }
+  else
+    {
+      top_down_diagnose (open_p, elif_bar_p, ENCLOSED_CLAUSE, CLOSE_SYMBOL);
+      longjmp (A68_PARSER (top_down_crash_exit), 1);
+      return NO_NODE;
+    }
+}
+
+/* Make branch of [ .. ].  */
+
+static NODE_T *
+top_down_sub (NODE_T *sub_p)
+{
+  NODE_T *bus_p = top_down_series (NEXT (sub_p));
+
+  if (bus_p != NO_NODE && IS (bus_p, BUS_SYMBOL))
+    {
+      a68_make_sub (sub_p, bus_p, SUB_SYMBOL);
+      return NEXT (sub_p);
+    }
+  else
+    {
+      top_down_diagnose (sub_p, bus_p, 0, BUS_SYMBOL);
+      longjmp (A68_PARSER (top_down_crash_exit), 1);
+      return NO_NODE;
+    }
+}
+
+/* Make branch of IF .. THEN .. ELSE .. FI.  */
+
+static NODE_T *
+top_down_if (NODE_T * if_p)
+{
+  NODE_T *then_p = top_down_series (NEXT (if_p)), *elif_p;
+
+  if (then_p == NO_NODE || !IS (then_p, THEN_SYMBOL))
+    {
+      top_down_diagnose (if_p, then_p, CONDITIONAL_CLAUSE, THEN_SYMBOL);
+      longjmp (A68_PARSER (top_down_crash_exit), 1);
+    }
+
+  a68_make_sub (if_p, PREVIOUS (then_p), IF_SYMBOL);
+
+  elif_p = top_down_series (NEXT (then_p));
+  if (elif_p != NO_NODE && IS (elif_p, FI_SYMBOL))
+    {
+      a68_make_sub (then_p, PREVIOUS (elif_p), THEN_SYMBOL);
+      a68_make_sub (if_p, elif_p, IF_SYMBOL);
+      return NEXT (if_p);
+    }
+
+  if (elif_p != NO_NODE && IS (elif_p, ELSE_SYMBOL))
+    {
+      NODE_T *fi_p = top_down_series (NEXT (elif_p));
+
+      if (fi_p == NO_NODE || !IS (fi_p, FI_SYMBOL))
+	{
+	  top_down_diagnose (if_p, fi_p, CONDITIONAL_CLAUSE, FI_SYMBOL);
+	  longjmp (A68_PARSER (top_down_crash_exit), 1);
+	}
+      else
+	{
+	  a68_make_sub (then_p, PREVIOUS (elif_p), THEN_SYMBOL);
+	  a68_make_sub (elif_p, PREVIOUS (fi_p), ELSE_SYMBOL);
+	  a68_make_sub (if_p, fi_p, IF_SYMBOL);
+	  return NEXT (if_p);
+	}
+    }
+
+  if (elif_p != NO_NODE && IS (elif_p, ELIF_SYMBOL))
+    {
+      NODE_T *fi_p = top_down_if (elif_p);
+
+      a68_make_sub (then_p, PREVIOUS (elif_p), THEN_SYMBOL);
+      a68_make_sub (if_p, elif_p, IF_SYMBOL);
+      return fi_p;
+    }
+  else
+    {
+      top_down_diagnose (if_p, elif_p, CONDITIONAL_CLAUSE, FI_SYMBOL);
+      longjmp (A68_PARSER (top_down_crash_exit), 1);
+      return NO_NODE;
+    }
+}
+
+/* Make branch of CASE .. IN .. OUT .. ESAC.  */
+
+static NODE_T *
+top_down_case (NODE_T *case_p)
+{
+  NODE_T *in_p = top_down_series (NEXT (case_p)), *ouse_p;
+
+  if (in_p == NO_NODE || !IS (in_p, IN_SYMBOL))
+    {
+      top_down_diagnose (case_p, in_p, ENCLOSED_CLAUSE, IN_SYMBOL);
+      longjmp (A68_PARSER (top_down_crash_exit), 1);
+    }
+
+  a68_make_sub (case_p, PREVIOUS (in_p), CASE_SYMBOL);
+
+  ouse_p = top_down_series (NEXT (in_p));
+  if (ouse_p != NO_NODE && IS (ouse_p, ESAC_SYMBOL))
+    {
+      a68_make_sub (in_p, PREVIOUS (ouse_p), IN_SYMBOL);
+      a68_make_sub (case_p, ouse_p, CASE_SYMBOL);
+      return NEXT (case_p);
+    }
+
+  if (ouse_p != NO_NODE && IS (ouse_p, OUT_SYMBOL))
+    {
+      NODE_T *esac_p = top_down_series (NEXT (ouse_p));
+
+      if (esac_p == NO_NODE || !IS (esac_p, ESAC_SYMBOL))
+	{
+	  top_down_diagnose (case_p, esac_p, ENCLOSED_CLAUSE, ESAC_SYMBOL);
+	  longjmp (A68_PARSER (top_down_crash_exit), 1);
+	}
+      else
+	{
+	  a68_make_sub (in_p, PREVIOUS (ouse_p), IN_SYMBOL);
+	  a68_make_sub (ouse_p, PREVIOUS (esac_p), OUT_SYMBOL);
+	  a68_make_sub (case_p, esac_p, CASE_SYMBOL);
+	  return NEXT (case_p);
+	}
+    }
+  
+  if (ouse_p != NO_NODE && IS (ouse_p, OUSE_SYMBOL))
+    {
+      NODE_T *esac_p = top_down_case (ouse_p);
+
+      a68_make_sub (in_p, PREVIOUS (ouse_p), IN_SYMBOL);
+      a68_make_sub (case_p, ouse_p, CASE_SYMBOL);
+      return esac_p;
+    }
+  else
+    {
+      top_down_diagnose (case_p, ouse_p, ENCLOSED_CLAUSE, ESAC_SYMBOL);
+      longjmp (A68_PARSER (top_down_crash_exit), 1);
+      return NO_NODE;
+    }
+}
+
+/* Skip a unit.  */
+
+static NODE_T *
+top_down_skip_unit (NODE_T *p)
+{
+  while (p != NO_NODE && !a68_is_unit_terminator (p))
+    {
+      if (IS (p, BEGIN_SYMBOL))
+	p = top_down_begin (p);
+      else if (IS (p, SUB_SYMBOL))
+	p = top_down_sub (p);
+      else if (IS (p, OPEN_SYMBOL))
+	p = top_down_open (p);
+      else if (IS (p, IF_SYMBOL))
+	p = top_down_if (p);
+      else if (IS (p, CASE_SYMBOL))
+	p = top_down_case (p);
+      else
+      FORWARD (p);
+    }
+  return p;
+}
+
+static NODE_T *top_down_skip_format (NODE_T *);
+
+/* Make branch of ( .. ) in a format.  */
+
+static NODE_T *
+top_down_format_open (NODE_T *open_p)
+{
+  NODE_T *close_p = top_down_skip_format (NEXT (open_p));
+
+  if (close_p != NO_NODE && IS (close_p, FORMAT_CLOSE_SYMBOL))
+    {
+      a68_make_sub (open_p, close_p, FORMAT_OPEN_SYMBOL);
+      return NEXT (open_p);
+    }
+  else
+    {
+      top_down_diagnose (open_p, close_p, 0, FORMAT_CLOSE_SYMBOL);
+      longjmp (A68_PARSER (top_down_crash_exit), 1);
+      return NO_NODE;
+    }
+}
+
+/* Skip a format text.  */
+
+static NODE_T *
+top_down_skip_format (NODE_T *p)
+{
+  while (p != NO_NODE)
+    {
+      if (IS (p, FORMAT_OPEN_SYMBOL))
+	p = top_down_format_open (p);
+      else if (a68_is_one_of (p, FORMAT_CLOSE_SYMBOL, FORMAT_DELIMITER_SYMBOL, STOP))
+	return p;
+      else
+	FORWARD (p);
+  }
+  return NO_NODE;
+}
+
+/* Make branch of $ .. $.  */
+
+static void
+top_down_formats (NODE_T * p)
+{
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (SUB (q) != NO_NODE)
+	top_down_formats (SUB (q));
+    }
+
+  for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
+    {
+      if (IS (q, FORMAT_DELIMITER_SYMBOL))
+	{
+	  NODE_T *f = NEXT (q);
+
+	  while (f != NO_NODE && !IS (f, FORMAT_DELIMITER_SYMBOL))
+	    {
+	      if (IS (f, FORMAT_OPEN_SYMBOL))
+		f = top_down_format_open (f);
+	      else
+		f = NEXT (f);
+	    }
+
+	  if (f == NO_NODE)
+	    {
+	      top_down_diagnose (p, f, FORMAT_TEXT, FORMAT_DELIMITER_SYMBOL);
+	      longjmp (A68_PARSER (top_down_crash_exit), 1);
+	    }
+	  else
+	    a68_make_sub (q, f, FORMAT_DELIMITER_SYMBOL);
+	}
+    }
+}
+
+/* Make branches of phrases for the bottom-up parser.  */
+
+void
+a68_top_down_parser (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return;
+
+  if (!setjmp (A68_PARSER (top_down_crash_exit)))
+    {
+      (void) top_down_series (p);
+      top_down_loops (p);
+      top_down_formats (p);
+    }
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser-victal.cc
@@ -0,0 +1,362 @@
+/* Syntax check for formal, actual and virtual declarers.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "options.h"
+
+#include "a68.h"
+
+static bool victal_check_declarer (NODE_T *, int);
+
+/* Check generator.  */
+
+static void
+victal_check_generator (NODE_T * p)
+{
+  if (!victal_check_declarer (NEXT (p), ACTUAL_DECLARER_MARK))
+    a68_error (p, "Y expected", "actual declarer");
+}
+
+/* Check formal pack.  */
+
+static void
+victal_check_formal_pack (NODE_T *p, int x, bool *z)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, FORMAL_DECLARERS))
+	victal_check_formal_pack (SUB (p), x, z);
+      else if (a68_is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, STOP))
+	victal_check_formal_pack (NEXT (p), x, z);
+      else if (IS (p, FORMAL_DECLARERS_LIST))
+	{
+	  victal_check_formal_pack (NEXT (p), x, z);
+	  victal_check_formal_pack (SUB (p), x, z);
+	}
+      else if (IS (p, DECLARER))
+	{
+	  victal_check_formal_pack (NEXT (p), x, z);
+	  (*z) &= victal_check_declarer (SUB (p), x);
+	}
+    }
+}
+
+/* Check operator declaration.  */
+
+static void
+victal_check_operator_dec (NODE_T *p)
+{
+  if (IS (NEXT (p), FORMAL_DECLARERS))
+    {
+      bool z = true;
+      victal_check_formal_pack (NEXT (p), FORMAL_DECLARER_MARK, &z);
+      if (!z)
+	a68_error (p, "Y expected", "formal declarers");
+      FORWARD (p);
+  }
+  if (!victal_check_declarer (NEXT (p), FORMAL_DECLARER_MARK))
+    a68_error (p, "Y expected", "formal declarer");
+}
+
+/* Check mode declaration.  */
+
+static void
+victal_check_mode_dec (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, MODE_DECLARATION))
+	{
+	  victal_check_mode_dec (SUB (p));
+	  victal_check_mode_dec (NEXT (p));
+	}
+      else if (a68_is_one_of (p, MODE_SYMBOL, DEFINING_INDICANT, STOP)
+               || a68_is_one_of (p, EQUALS_SYMBOL, COMMA_SYMBOL, STOP))
+	{
+	  victal_check_mode_dec (NEXT (p));
+	}
+      else if (IS (p, DECLARER))
+	{
+	  if (!victal_check_declarer (p, ACTUAL_DECLARER_MARK))
+	    a68_error (p, "Y expected", "actual declarer");
+	}
+    }
+}
+
+/* Check variable declaration. */
+
+static void
+victal_check_variable_dec (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, VARIABLE_DECLARATION))
+	{
+	  victal_check_variable_dec (SUB (p));
+	  victal_check_variable_dec (NEXT (p));
+	}
+      else
+	{
+	  if (IS (p, QUALIFIER))
+	    FORWARD (p);
+
+	  if (a68_is_one_of (p, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, STOP)
+	      || IS (p, COMMA_SYMBOL))
+	    victal_check_variable_dec (NEXT (p));
+	  else if (IS (p, UNIT))
+	    a68_victal_checker (SUB (p));
+	  else if (IS (p, DECLARER))
+	    {
+	      if (!victal_check_declarer (p, ACTUAL_DECLARER_MARK))
+		a68_error (p, "Y expected", "actual declarer");
+	      victal_check_variable_dec (NEXT (p));
+	    }
+	}
+    }
+}
+
+/* Check identity declaration.  */
+
+static void
+victal_check_identity_dec (NODE_T * p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, IDENTITY_DECLARATION))
+	{
+	  victal_check_identity_dec (SUB (p));
+	  victal_check_identity_dec (NEXT (p));
+	}
+      else if (a68_is_one_of (p, DEFINING_IDENTIFIER, EQUALS_SYMBOL, COMMA_SYMBOL, STOP))
+	victal_check_identity_dec (NEXT (p));
+      else if (IS (p, UNIT))
+	a68_victal_checker (SUB (p));
+      else if (IS (p, DECLARER))
+	{
+	  if (!victal_check_declarer (p, FORMAL_DECLARER_MARK))
+	    a68_error (p, "Y expected", "formal declarer");
+	  victal_check_identity_dec (NEXT (p));
+	}
+    }
+}
+
+/* Check routine pack.  */
+
+static void
+victal_check_routine_pack (NODE_T *p, int x, bool *z)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, PARAMETER_PACK))
+	victal_check_routine_pack (SUB (p), x, z);
+      else if (a68_is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, STOP))
+	victal_check_routine_pack (NEXT (p), x, z);
+      else if (a68_is_one_of (p, PARAMETER_LIST, PARAMETER, STOP))
+	{
+	  victal_check_routine_pack (NEXT (p), x, z);
+	  victal_check_routine_pack (SUB (p), x, z);
+	}
+      else if (IS (p, DECLARER))
+	*z &= victal_check_declarer (SUB (p), x);
+    }
+}
+
+/* Check routine text.  */
+
+static void
+victal_check_routine_text (NODE_T *p)
+{
+  if (IS (p, PARAMETER_PACK))
+    {
+      bool z = true;
+      victal_check_routine_pack (p, FORMAL_DECLARER_MARK, &z);
+      if (!z)
+	a68_error (p, "Y expected", "formal declarers");
+      FORWARD (p);
+    }
+  if (!victal_check_declarer (p, FORMAL_DECLARER_MARK))
+    a68_error (p, "Y expected", "formal declarer");
+  a68_victal_checker (NEXT (p));
+}
+
+/* Check structure pack.  */
+
+static void
+victal_check_structure_pack (NODE_T *p, int x, bool *z)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, STRUCTURE_PACK))
+	victal_check_structure_pack (SUB (p), x, z);
+      else if (a68_is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, STOP))
+	victal_check_structure_pack (NEXT (p), x, z);
+      else if (a68_is_one_of (p, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD, STOP))
+	{
+	  victal_check_structure_pack (NEXT (p), x, z);
+	  victal_check_structure_pack (SUB (p), x, z);
+	}
+      else if (IS (p, DECLARER))
+	(*z) &= victal_check_declarer (SUB (p), x);
+    }
+}
+
+/* Check union pack.  */
+
+static void
+victal_check_union_pack (NODE_T * p, int x, bool * z)
+{
+  if (p != NO_NODE)
+    {
+    if (IS (p, UNION_PACK))
+      victal_check_union_pack (SUB (p), x, z);
+    else if (a68_is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, VOID_SYMBOL, STOP))
+      victal_check_union_pack (NEXT (p), x, z);
+    else if (IS (p, UNION_DECLARER_LIST))
+      {
+	victal_check_union_pack (NEXT (p), x, z);
+	victal_check_union_pack (SUB (p), x, z);
+      }
+    else if (IS (p, DECLARER))
+      {
+	victal_check_union_pack (NEXT (p), x, z);
+	(*z) &= victal_check_declarer (SUB (p), FORMAL_DECLARER_MARK);
+      }
+    }
+}
+
+/* Check declarer.  */
+
+static bool
+victal_check_declarer (NODE_T *p, int x)
+{
+  if (p == NO_NODE)
+    return false;
+  else if (IS (p, DECLARER))
+    return victal_check_declarer (SUB (p), x);
+  else if (a68_is_one_of (p, LONGETY, SHORTETY, STOP))
+    return true;
+  else if (a68_is_one_of (p, VOID_SYMBOL, INDICANT, STANDARD, STOP))
+    return true;
+  else if (IS_REF (p))
+    return victal_check_declarer (NEXT (p), VIRTUAL_DECLARER_MARK);
+  else if (IS_FLEX (p))
+    return victal_check_declarer (NEXT (p), x);
+  else if (IS (p, BOUNDS))
+    {
+      a68_victal_checker (SUB (p));
+      if (x == FORMAL_DECLARER_MARK)
+	{
+	  a68_error (p, "Y expected", "formal bounds");
+	  (void) victal_check_declarer (NEXT (p), x);
+	  return true;
+	}
+      else if (x == VIRTUAL_DECLARER_MARK)
+	{
+	  a68_error (p, "Y expected", "virtual bounds");
+	  (void) victal_check_declarer (NEXT (p), x);
+	  return true;
+	}
+      else
+	return victal_check_declarer (NEXT (p), x);
+    }
+  else if (IS (p, FORMAL_BOUNDS))
+    {
+      a68_victal_checker (SUB (p));
+      if (x == ACTUAL_DECLARER_MARK)
+	{
+	  a68_error (p, "Y expected", "actual bounds");
+	  (void) victal_check_declarer (NEXT (p), x);
+	  return true;
+	}
+      else
+	return victal_check_declarer (NEXT (p), x);
+    }
+  else if (IS (p, STRUCT_SYMBOL))
+    {
+      bool z = true;
+      victal_check_structure_pack (NEXT (p), x, &z);
+      return z;
+    }
+  else if (IS (p, UNION_SYMBOL))
+    {
+      bool z = true;
+      victal_check_union_pack (NEXT (p), FORMAL_DECLARER_MARK, &z);
+      if (!z)
+	a68_error (p, "Y expected", "formal declarer pack");
+      return true;
+    }
+  else if (IS (p, PROC_SYMBOL))
+    {
+      if (IS (NEXT (p), FORMAL_DECLARERS))
+	{
+	  bool z = true;
+	  victal_check_formal_pack (NEXT (p), FORMAL_DECLARER_MARK, &z);
+	  if (!z)
+	    a68_error (p, "Y expected", "formal declarer");
+	  FORWARD (p);
+	}
+      if (!victal_check_declarer (NEXT (p), FORMAL_DECLARER_MARK))
+	a68_error (p, "Y expected", "formal declarer");
+      return true;
+    }
+  else
+    return false;
+}
+
+/* Check cast.  */
+
+static void
+victal_check_cast (NODE_T *p)
+{
+  if (!victal_check_declarer (p, FORMAL_DECLARER_MARK))
+    {
+      a68_error (p, "Y expected", "formal declarer");
+      a68_victal_checker (NEXT (p));
+    }
+}
+
+/* Driver for checking VICTALITY of declarers.  */
+
+void
+a68_victal_checker (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, MODE_DECLARATION))
+	victal_check_mode_dec (SUB (p));
+      else if (IS (p, VARIABLE_DECLARATION))
+	victal_check_variable_dec (SUB (p));
+      else if (IS (p, IDENTITY_DECLARATION))
+	victal_check_identity_dec (SUB (p));
+      else if (IS (p, GENERATOR))
+	victal_check_generator (SUB (p));
+      else if (IS (p, ROUTINE_TEXT))
+	victal_check_routine_text (SUB (p));
+      else if (IS (p, OPERATOR_PLAN))
+	victal_check_operator_dec (SUB (p));
+      else if (IS (p, CAST))
+	victal_check_cast (SUB (p));
+      else
+	a68_victal_checker (SUB (p));
+    }
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-parser.cc
@@ -0,0 +1,1134 @@
+/* ALGOL 68 parser.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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 a Mailloux-type parser driver.
+
+   The Algol 68 grammar is a two level (Van Wijngaarden, "VW") grammar
+   that incorporates, as syntactical rules, the semantical rules in
+   other languages. Examples are correct use of symbols, modes and
+   scope.
+
+   This code constitutes an effective "VW Algol 68 parser". A
+   pragmatic approach was chosen since in the early days of Algol 68,
+   many "ab initio" implementations failed, probably because
+   techniques to parse a language like Algol 68 had yet to be
+   invented.
+
+   This is a Mailloux-type parser, in the sense that it scans a
+   "phrase" for definitions needed for parsing. Algol 68 allows for
+   tags to be used before they are defined, which gives freedom in
+   top-down programming.
+
+     B. J. Mailloux. On the implementation of Algol 68.
+     Thesis, Universiteit van Amsterdam (Mathematisch Centrum) [1968].
+
+   Technically, Mailloux's approach renders the two-level grammar
+   LALR.
+
+   First part of the parser is the scanner. The source file is read, is
+   tokenised.  The result is a linear list of tokens that is input for the
+   parser, that will transform the linear list into a syntax tree.
+
+   This front-end tokenises all symbols before the bottom-up parser is invoked.
+   This means that scanning does not use information from the parser.  The
+   scanner does of course some rudimentary parsing.
+
+   The scanner supports two stropping regimes: "bold" (or "upper") and
+   "quote".  Examples of both:
+
+    bold stropping: BEGIN INT i = 1, j = 1; print (i + j) END
+
+    quote stropping: 'BEGIN' 'INT' I = 1, J = 1; PRINT (I + J) 'END'
+
+   Quote stropping was used frequently in the (excusez-le-mot)
+   punch-card age.  Hence, bold stropping is the default. There also
+   existed point stropping, but that has not been implemented here.
+
+   Next part of the parser is a recursive-descent type to check
+   parenthesis.  Also a first set-up is made of symbol tables, needed
+   by the bottom-up parser.  Next part is the bottom-up parser, that
+   parses without knowing modes while parsing and reducing. It can
+   therefore not exchange "[]" with "()" as was blessed by the Revised
+   Report. This is solved by treating CALL and SLICE as equivalent for
+   the moment and letting the mode checker sort it out later.
+
+   Parsing progresses in various phases to avoid spurious diagnostics
+   from a recovering parser. Every phase "tightens" the grammar more.
+   An error in any phase makes the parser quit when that phase ends.
+   The parser is forgiving in case of superfluous semicolons.
+
+   These are the parser phases:
+
+   (1) Parenthesis are checked to see whether they match. Then, a top-down
+       parser determines the basic-block structure of the program
+       so symbol tables can be set up that the bottom-up parser will consult
+       as you can define things before they are applied.
+
+   (2) A bottom-up parser resolves the structure of the program.
+
+   (3) After the symbol tables have been finalised, a small rearrangement of the
+       tree may be required where JUMPs have no GOTO. This leads to the
+       non-standard situation that JUMPs without GOTO can have the syntactic
+       position of a PRIMARY, SECONDARY or TERTIARY. The bottom-up parser also
+       does not check VICTAL correctness of declarers. This is done separately.
+
+  The parser sets up symbol tables and populates them as far as needed to parse
+  the source. After the bottom-up parser terminates succesfully, the symbol tables
+  are completed.
+
+   (4) Next, modes are collected and rules for well-formedness and structural
+       equivalence are applied. Then the symbol-table is completed now moids are
+       all known.
+
+   (5) Next phases are the mode checker and coercion inserter. The syntax tree is
+       traversed to determine and check all modes, and to select operators. Then
+       the tree is traversed again to insert coercions.
+
+   (6) A static scope checker detects where objects are transported out of scope.
+       At run time, a dynamic scope checker will check that what the static scope
+       checker cannot see.
+
+   (7) A serial-clause dynamic stack allocation (DSA) phase annotates the
+       serial clauses that contain phrases whose elaboration may result in
+       dynamic stack adjustments.
+*/
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "diagnostic.h"
+#include "tree.h"
+
+#include "a68.h"
+
+/* Global state kept by the parser.  */
+
+PARSER_T a68_parser_state;
+
+/* A few forward declarations of functions defined below.  */
+
+static void make_special_mode (MOID_T ** n, int m);
+static void tie_label_to_serial (NODE_T *p);
+static void tie_label_to_unit (NODE_T *p);
+
+/* Is_ref_refety_flex.  */
+
+bool
+a68_is_ref_refety_flex (MOID_T *m)
+{
+  if (IS_REF_FLEX (m))
+    return true;
+  else if (IS_REF (m))
+    return a68_is_ref_refety_flex (SUB (m));
+  else
+    return false;
+}
+
+/* Count number of operands in operator parameter list.  */
+
+int
+a68_count_operands (NODE_T *p)
+{
+  if (p != NO_NODE)
+    {
+      if (IS (p, DECLARER))
+	return a68_count_operands (NEXT (p));
+      else if (IS (p, COMMA_SYMBOL))
+	return 1 + a68_count_operands (NEXT (p));
+      else
+	return a68_count_operands (NEXT (p)) + a68_count_operands (SUB (p));
+    }
+  else
+    return 0;
+}
+
+/* Count formal bounds in declarer in tree.  */
+
+int
+a68_count_formal_bounds (NODE_T * p)
+{
+  if (p == NO_NODE)
+    return 0;
+  else
+    {
+      if (IS (p, COMMA_SYMBOL))
+	return 1;
+      else
+	return a68_count_formal_bounds (NEXT (p)) + a68_count_formal_bounds (SUB (p));
+    }
+}
+
+/* Count pictures.  */
+
+void
+a68_count_pictures (NODE_T *p, int *k)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, PICTURE))
+	(*k)++;
+      a68_count_pictures (SUB (p), k);
+    }
+}
+
+/* Whether token cannot follow semicolon or EXIT.  */
+
+bool
+a68_is_semicolon_less (NODE_T *p)
+{
+  switch (ATTRIBUTE (p))
+    {
+    case BUS_SYMBOL:
+    case CLOSE_SYMBOL:
+    case END_SYMBOL:
+    case SEMI_SYMBOL:
+    case EXIT_SYMBOL:
+    case THEN_BAR_SYMBOL:
+    case ELSE_BAR_SYMBOL:
+    case THEN_SYMBOL:
+    case ELIF_SYMBOL:
+    case ELSE_SYMBOL:
+    case FI_SYMBOL:
+    case IN_SYMBOL:
+    case OUT_SYMBOL:
+    case OUSE_SYMBOL:
+    case ESAC_SYMBOL:
+    case OD_SYMBOL:
+      return true;
+    default:
+      return false;
+    }
+}
+
+/* Whether formal bounds.  */
+
+bool
+a68_is_formal_bounds (NODE_T *p)
+{
+  if (p == NO_NODE)
+    return true;
+
+  switch (ATTRIBUTE (p))
+    {
+    case OPEN_SYMBOL:
+    case CLOSE_SYMBOL:
+    case SUB_SYMBOL:
+    case BUS_SYMBOL:
+    case COMMA_SYMBOL:
+    case COLON_SYMBOL:
+    case INT_DENOTATION:
+    case IDENTIFIER:
+    case OPERATOR:
+      return (a68_is_formal_bounds (SUB (p))
+	      && a68_is_formal_bounds (NEXT (p)));
+    default:
+        return false;
+    }
+}
+
+/* Whether token terminates a unit.  */
+
+bool
+a68_is_unit_terminator (NODE_T *p)
+{
+  switch (ATTRIBUTE (p))
+    {
+    case BUS_SYMBOL:
+    case CLOSE_SYMBOL:
+    case END_SYMBOL:
+    case SEMI_SYMBOL:
+    case EXIT_SYMBOL:
+    case COMMA_SYMBOL:
+    case THEN_BAR_SYMBOL:
+    case ELSE_BAR_SYMBOL:
+    case THEN_SYMBOL:
+    case ELIF_SYMBOL:
+    case ELSE_SYMBOL:
+    case FI_SYMBOL:
+    case IN_SYMBOL:
+    case OUT_SYMBOL:
+    case OUSE_SYMBOL:
+    case ESAC_SYMBOL:
+      return true;
+    default:
+      return false;
+    }
+}
+
+/* Whether token is a unit-terminator in a loop clause.  */
+
+bool
+a68_is_loop_keyword (NODE_T *p)
+{
+  switch (ATTRIBUTE (p))
+    {
+    case FOR_SYMBOL:
+    case FROM_SYMBOL:
+    case BY_SYMBOL:
+    case TO_SYMBOL:
+    case WHILE_SYMBOL:
+    case DO_SYMBOL:
+      return true;
+    default:
+      return false;
+    }
+}
+
+/* Get good attribute.  */
+
+enum a68_attribute
+a68_get_good_attribute (NODE_T *p)
+{
+  switch (ATTRIBUTE (p))
+    {
+    case UNIT:
+    case TERTIARY:
+    case SECONDARY:
+    case PRIMARY:
+      return a68_get_good_attribute (SUB (p));
+    default:
+      return ATTRIBUTE (p);
+    }
+}
+
+/* Preferably don't put intelligible diagnostic here.  */
+
+bool
+a68_dont_mark_here (NODE_T *p)
+{
+  switch (ATTRIBUTE (p))
+    {
+    case ALT_DO_SYMBOL:
+    case ALT_EQUALS_SYMBOL:
+    case ANDF_SYMBOL:
+    case ASSERT_SYMBOL:
+    case ASSIGN_SYMBOL:
+    case ASSIGN_TO_SYMBOL:
+    case AT_SYMBOL:
+    case BEGIN_SYMBOL:
+    case BITS_SYMBOL:
+    case BOLD_COMMENT_SYMBOL:
+    case BOLD_PRAGMAT_SYMBOL:
+    case BOLD_COMMENT_BEGIN_SYMBOL:
+    case BOLD_COMMENT_END_SYMBOL:
+    case BOOL_SYMBOL:
+    case BUS_SYMBOL:
+    case BY_SYMBOL:
+    case BYTES_SYMBOL:
+    case CASE_SYMBOL:
+    case CHANNEL_SYMBOL:
+    case CHAR_SYMBOL:
+    case CLOSE_SYMBOL:
+    case COLON_SYMBOL:
+    case COMMA_SYMBOL:
+    case COMPLEX_SYMBOL:
+    case COMPL_SYMBOL:
+    case DO_SYMBOL:
+    case ELIF_SYMBOL:
+    case ELSE_BAR_SYMBOL:
+    case ELSE_SYMBOL:
+    case EMPTY_SYMBOL:
+    case END_SYMBOL:
+    case EQUALS_SYMBOL:
+    case ESAC_SYMBOL:
+    case EXIT_SYMBOL:
+    case FALSE_SYMBOL:
+    case FILE_SYMBOL:
+    case FI_SYMBOL:
+    case FLEX_SYMBOL:
+    case FOR_SYMBOL:
+    case FROM_SYMBOL:
+    case GO_SYMBOL:
+    case GOTO_SYMBOL:
+    case HEAP_SYMBOL:
+    case IF_SYMBOL:
+    case IN_SYMBOL:
+    case INT_SYMBOL:
+    case ISNT_SYMBOL:
+    case IS_SYMBOL:
+    case LOC_SYMBOL:
+    case LONG_SYMBOL:
+    case MAIN_SYMBOL:
+    case MODE_SYMBOL:
+    case NIL_SYMBOL:
+    case OD_SYMBOL:
+    case OF_SYMBOL:
+    case OPEN_SYMBOL:
+    case OP_SYMBOL:
+    case ORF_SYMBOL:
+    case OUSE_SYMBOL:
+    case OUT_SYMBOL:
+    case PAR_SYMBOL:
+    case POINT_SYMBOL:
+    case PRIO_SYMBOL:
+    case PROC_SYMBOL:
+    case REAL_SYMBOL:
+    case REF_SYMBOL:
+    case ROWS_SYMBOL:
+    case ROW_SYMBOL:
+    case SEMA_SYMBOL:
+    case SEMI_SYMBOL:
+    case SHORT_SYMBOL:
+    case SKIP_SYMBOL:
+    case STRING_SYMBOL:
+    case STRUCT_SYMBOL:
+    case STYLE_I_COMMENT_SYMBOL:
+    case STYLE_II_COMMENT_SYMBOL:
+    case STYLE_I_PRAGMAT_SYMBOL:
+    case SUB_SYMBOL:
+    case THEN_BAR_SYMBOL:
+    case THEN_SYMBOL:
+    case TO_SYMBOL:
+    case TRUE_SYMBOL:
+    case UNION_SYMBOL:
+    case VOID_SYMBOL:
+    case WHILE_SYMBOL:
+    case SERIAL_CLAUSE:
+    case ENQUIRY_CLAUSE:
+    case INITIALISER_SERIES:
+    case DECLARATION_LIST:
+      return true;
+    default:
+      return false;
+    }
+}
+
+/* Renumber nodes in the given subtree P, starting with number N.  */
+
+static void
+renumber_nodes (NODE_T *p, int *n)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      NUMBER (p) = (*n)++;
+      renumber_nodes (SUB (p), n);
+    }
+}
+
+/* Parse an ALGOL 68 source file.  */
+
+void
+a68_parser (const char *filename)
+{
+  int renum = 0;
+
+  /* Initialisation.  */
+  A68 (top_keyword) = NO_KEYWORD;
+  A68 (top_token) = NO_TOKEN;
+  A68_PARSER (error_tag) = (TAG_T *) a68_new_tag ();
+  TOP_NODE (&A68_JOB) = NO_NODE;
+  TOP_MOID (&A68_JOB) = NO_MOID;
+  TOP_LINE (&A68_JOB) = NO_LINE;
+  STANDENV_MOID (&A68_JOB) = NO_MOID;
+  a68_set_up_tables ();
+  ERROR_COUNT (&A68_JOB) = WARNING_COUNT (&A68_JOB) = 0;
+
+  /* Tokeniser.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    {
+      bool ok = a68_lexical_analyser (filename);
+
+      if (!ok)
+	return;
+
+      /* An empty file is not a valid program.  */
+      if (TOP_NODE (&A68_JOB) == NO_NODE)
+	{
+	  a68_error (NO_NODE, "file is empty, expected a program");
+	  return;
+	}
+
+      TREE_LISTING_SAFE (&A68_JOB) = true;
+      renum = 0;
+      renumber_nodes (TOP_NODE (&A68_JOB), &renum);
+    }
+
+  /* Final initialisations.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    {
+      A68_STANDENV = NO_TABLE;
+      a68_init_postulates ();
+      A68 (mode_count) = 0;
+      make_special_mode (&M_HIP, A68 (mode_count)++);
+      make_special_mode (&M_UNDEFINED, A68 (mode_count)++);
+      make_special_mode (&M_ERROR, A68 (mode_count)++);
+      make_special_mode (&M_VACUUM, A68 (mode_count)++);
+      make_special_mode (&M_C_STRING, A68 (mode_count)++);
+      make_special_mode (&M_COLLITEM, A68 (mode_count)++);
+    }
+
+  /* Top-down parser.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    {
+      a68_check_parenthesis (TOP_NODE (&A68_JOB));
+      if (ERROR_COUNT (&A68_JOB) == 0)
+	{
+	  if (OPTION_BRACKETS (&A68_JOB))
+	    a68_substitute_brackets (TOP_NODE (&A68_JOB));
+	  A68 (symbol_table_count) = 0;
+	  A68_STANDENV = a68_new_symbol_table (NO_TABLE);
+	  LEVEL (A68_STANDENV) = 0;
+	  a68_top_down_parser (TOP_NODE (&A68_JOB));
+	}
+
+      renum = 0;
+      renumber_nodes (TOP_NODE (&A68_JOB), &renum);
+    }
+
+  /* Standard environment builder.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    {
+      TABLE (TOP_NODE (&A68_JOB)) = a68_new_symbol_table (A68_STANDENV);
+      a68_make_standard_environ ();
+      STANDENV_MOID (&A68_JOB) = TOP_MOID (&A68_JOB);
+    }
+
+  /* Bottom-up parser.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    {
+      a68_preliminary_symbol_table_setup (TOP_NODE (&A68_JOB));
+      a68_bottom_up_parser (TOP_NODE (&A68_JOB));
+      renum = 0;
+      renumber_nodes (TOP_NODE (&A68_JOB), &renum);
+    }
+
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    {
+      a68_bottom_up_error_check (TOP_NODE (&A68_JOB));
+      a68_victal_checker (TOP_NODE (&A68_JOB));
+      if (ERROR_COUNT (&A68_JOB) == 0)
+	{
+	  a68_finalise_symbol_table_setup (TOP_NODE (&A68_JOB), 2);
+	  NEST (TABLE (TOP_NODE (&A68_JOB))) = A68 (symbol_table_count) = 3;
+	  a68_reset_symbol_table_nest_count (TOP_NODE (&A68_JOB));
+	  a68_fill_symbol_table_outer (TOP_NODE (&A68_JOB), TABLE (TOP_NODE (&A68_JOB)));
+	  a68_set_nest (TOP_NODE (&A68_JOB), NO_NODE);
+	  a68_set_proc_level (TOP_NODE (&A68_JOB), 1);
+	}
+      renum = 0;
+      renumber_nodes (TOP_NODE (&A68_JOB), &renum);
+    }
+
+  /* Mode table builder.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    a68_make_moid_list (&A68_JOB);
+  CROSS_REFERENCE_SAFE (&A68_JOB) = true;
+
+  /* Symbol table builder.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    a68_collect_taxes (TOP_NODE (&A68_JOB));
+
+  /* Post parser.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    a68_rearrange_goto_less_jumps (TOP_NODE (&A68_JOB));
+
+  /* Mode checker.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    a68_mode_checker (TOP_NODE (&A68_JOB));
+
+  /* Coercion inserter.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    {
+      a68_coercion_inserter (TOP_NODE (&A68_JOB));
+      renum = 0;
+      renumber_nodes (TOP_NODE (&A68_JOB), &renum);
+    }
+
+  /* Application checker.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    {
+      a68_mark_moids (TOP_NODE (&A68_JOB));
+      a68_mark_auxilliary (TOP_NODE (&A68_JOB));
+      a68_jumps_from_procs (TOP_NODE (&A68_JOB));
+      a68_warn_for_unused_tags (TOP_NODE (&A68_JOB));
+    }
+
+  /* Static scope checker.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    {
+      tie_label_to_serial (TOP_NODE (&A68_JOB));
+      tie_label_to_unit (TOP_NODE (&A68_JOB));
+      a68_bind_routine_tags_to_tree (TOP_NODE (&A68_JOB));
+      a68_scope_checker (TOP_NODE (&A68_JOB));
+    }
+
+  /* Serial dynamic stack allocation checker.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    {
+      a68_serial_dsa (TOP_NODE (&A68_JOB));
+    }
+
+  /* Finalise syntax tree.  */
+  if (ERROR_COUNT (&A68_JOB) == 0)
+    {
+      int num = 0;
+      renumber_nodes (TOP_NODE (&A68_JOB), &num);
+      NEST (TABLE (TOP_NODE (&A68_JOB))) = A68 (symbol_table_count) = 3;
+      a68_reset_symbol_table_nest_count (TOP_NODE (&A68_JOB));
+    }
+}
+
+/* New_node_info.  */
+
+NODE_INFO_T *
+a68_new_node_info (void)
+{
+  NODE_INFO_T *z = (NODE_INFO_T *) xmalloc (sizeof (NODE_INFO_T));
+
+  A68 (new_node_infos)++;
+  PROCEDURE_LEVEL (z) = 0;
+  CHAR_IN_LINE (z) = NO_TEXT;
+  SYMBOL (z) = NO_TEXT;
+  PRAGMENT (z) = NO_TEXT;
+  PRAGMENT_TYPE (z) = 0;
+  LINE (z) = NO_LINE;
+  return z;
+}
+
+/* New_genie_info.  */
+
+GINFO_T *
+a68_new_genie_info (void)
+{
+  GINFO_T *z = (GINFO_T *) xmalloc (sizeof (GINFO_T));
+
+  A68 (new_genie_infos)++;
+  PARTIAL_PROC (z) = NO_MOID;
+  PARTIAL_LOCALE (z) = NO_MOID;
+  return z;
+}
+
+/* Allocate and return a new parse tree node with proper defaults.  */
+
+NODE_T *
+a68_new_node (void)
+{
+  NODE_T *z = (NODE_T *) xmalloc (sizeof (NODE_T));
+
+  A68 (new_nodes)++;
+  TABLE (z) = NO_TABLE;
+  INFO (z) = NO_NINFO;
+  GINFO (z) = NO_GINFO;
+  ATTRIBUTE (z) = STOP;
+  ANNOTATION (z) = STOP;
+  MOID (z) = NO_MOID;
+  NEXT (z) = NO_NODE;
+  PREVIOUS (z) = NO_NODE;
+  SUB (z) = NO_NODE;
+  NEST (z) = NO_NODE;
+  NON_LOCAL (z) = NO_TABLE;
+  TAX (z) = NO_TAG;
+  SEQUENCE (z) = NO_NODE;
+  PACK (z) = NO_PACK;
+  CDECL (z) = NULL_TREE;
+  DYNAMIC_STACK_ALLOCS (z) = false;
+  return z;
+}
+
+/* Some_node.  */
+
+NODE_T *
+a68_some_node (const char *t)
+{
+  NODE_T *z = a68_new_node ();
+  INFO (z) = a68_new_node_info ();
+  GINFO (z) = a68_new_genie_info ();
+  NSYMBOL (z) = t;
+  return z;
+}
+
+/* New_symbol_table.  */
+
+TABLE_T *
+a68_new_symbol_table (TABLE_T *p)
+{
+  TABLE_T *z = (TABLE_T *) xmalloc (sizeof (TABLE_T));
+
+  NUM (z) = A68 (symbol_table_count);
+  LEVEL (z) = A68 (symbol_table_count)++;
+  NEST (z) = A68 (symbol_table_count);
+  ATTRIBUTE (z) = 0;
+  INITIALISE_FRAME (z) = true;
+  PROC_OPS (z) = true;
+  INITIALISE_ANON (z) = true;
+  PREVIOUS (z) = p;
+  OUTER (z) = NO_TABLE;
+  IDENTIFIERS (z) = NO_TAG;
+  OPERATORS (z) = NO_TAG;
+  PRIO (z) = NO_TAG;
+  INDICANTS (z) = NO_TAG;
+  LABELS (z) = NO_TAG;
+  ANONYMOUS (z) = NO_TAG;
+  JUMP_TO (z) = NO_NODE;
+  SEQUENCE (z) = NO_NODE;
+  return z;
+}
+
+/* New_moid.  */
+
+MOID_T *
+a68_new_moid (void)
+{
+  MOID_T *z = (MOID_T *) xmalloc (sizeof (MOID_T));
+
+  A68 (new_modes)++;
+  ATTRIBUTE (z) = 0;
+  NUMBER (z) = 0;
+  DIM (z) = 0;
+  USE (z) = false;
+  HAS_ROWS (z) = false;
+  PORTABLE (z) = true;
+  DERIVATE (z) = false;
+  NODE (z) = NO_NODE;
+  PACK (z) = NO_PACK;
+  SUB (z) = NO_MOID;
+  EQUIVALENT_MODE (z) = NO_MOID;
+  SLICE (z) = NO_MOID;
+  TRIM (z) = NO_MOID;
+  DEFLEXED (z) = NO_MOID;
+  NAME (z) = NO_MOID;
+  MULTIPLE_MODE (z) = NO_MOID;
+  NEXT (z) = NO_MOID;
+  CTYPE (z) = NULL_TREE;
+  return z;
+}
+
+/* New_pack.  */
+
+PACK_T *
+a68_new_pack (void)
+{
+  PACK_T *z = (PACK_T *) xmalloc (sizeof (PACK_T));
+
+  MOID (z) = NO_MOID;
+  TEXT (z) = NO_TEXT;
+  NODE (z) = NO_NODE;
+  NEXT (z) = NO_PACK;
+  PREVIOUS (z) = NO_PACK;
+  return z;
+}
+
+/* New_tag.  */
+
+TAG_T *
+a68_new_tag (void)
+{
+  TAG_T *z = (TAG_T *) xmalloc (sizeof (TAG_T));
+
+  STATUS (z) = NULL_MASK;
+  TAG_TABLE (z) = NO_TABLE;
+  MOID (z) = NO_MOID;
+  NODE (z) = NO_NODE;
+  UNIT (z) = NO_NODE;
+  VALUE (z) = NO_TEXT;
+  SCOPE (z) = PRIMAL_SCOPE;
+  SCOPE_ASSIGNED (z) = false;
+  PRIO (z) = 0;
+  USE (z) = false;
+  IN_PROC (z) = false;
+  HEAP (z) = false;
+  YOUNGEST_ENVIRON (z) = PRIMAL_SCOPE;
+  LOC_ASSIGNED (z) = false;
+  NEXT (z) = NO_TAG;
+  BODY (z) = NO_TAG;
+  PORTABLE (z) = true;
+  VARIABLE (z) = false;
+  IS_RECURSIVE (z) = false;
+  ASCRIBED_ROUTINE_TEXT (z) = false;
+  LOWERER (z) = NO_LOWERER;
+  TAX_TREE_DECL (z) = NULL_TREE;
+  NUMBER (z) = ++A68_PARSER (tag_number);
+  return z;
+}
+
+/* Make special, internal mode.  */
+
+static void
+make_special_mode (MOID_T ** n, int m)
+{
+  (*n) = a68_new_moid ();
+  ATTRIBUTE (*n) = 0;
+  NUMBER (*n) = m;
+  PACK (*n) = NO_PACK;
+  SUB (*n) = NO_MOID;
+  EQUIVALENT (*n) = NO_MOID;
+  DEFLEXED (*n) = NO_MOID;
+  NAME (*n) = NO_MOID;
+  SLICE (*n) = NO_MOID;
+  TRIM (*n) = NO_MOID;
+  ROWED (*n) = NO_MOID;
+}
+
+/* Whether attributes match in subsequent nodes.  */
+
+bool
+a68_whether (NODE_T * p, ...)
+{
+  va_list vl;
+  va_start (vl, p);
+  int a;
+  while ((a = va_arg (vl, int)) != STOP)
+  {
+    if (p != NO_NODE && a == WILDCARD)
+      FORWARD (p);
+    else if (p != NO_NODE && (a == KEYWORD))
+      {
+	if (a68_find_keyword_from_attribute (A68 (top_keyword), ATTRIBUTE (p)) != NO_KEYWORD)
+	  FORWARD (p);
+	else
+	  {
+	    va_end (vl);
+	    return false;
+	  }
+      }
+    else if (p != NO_NODE && (a >= 0 ? a == ATTRIBUTE (p) : (-a) != ATTRIBUTE (p)))
+      FORWARD (p);
+    else
+      {
+	va_end (vl);
+	return false;
+      }
+  }
+  va_end (vl);
+  return true;
+}
+
+/* Whether one of a series of attributes matches a node.  */
+
+bool
+a68_is_one_of (NODE_T *p, ...)
+{
+  if (p != NO_NODE)
+    {
+      bool match = false;
+      int a;
+
+      va_list vl;
+      va_start (vl, p);
+      while ((a = va_arg (vl, int)) != STOP)
+	match = (match | IS (p, a));
+      va_end (vl);
+      return match;
+    }
+  else
+    return false;
+}
+
+
+/* Isolate nodes p-q making p a branch to p-q
+
+   From x - p - a - b - c - q - y
+   To   x - t - y
+            |
+            p - a - b - c - q
+*/
+
+void
+a68_make_sub (NODE_T *p, NODE_T *q, enum a68_attribute t)
+{
+  NODE_T *z = a68_new_node ();
+
+  gcc_assert (p != NO_NODE && q != NO_NODE);
+  *z = *p;
+
+  if (GINFO (p) != NO_GINFO)
+    GINFO (z) = a68_new_genie_info ();
+
+  PREVIOUS (z) = NO_NODE;
+
+  if (p == q)
+    NEXT (z) = NO_NODE;
+  else
+    {
+      if (NEXT (p) != NO_NODE)
+	PREVIOUS (NEXT (p)) = z;
+      NEXT (p) = NEXT (q);
+      if (NEXT (p) != NO_NODE)
+	PREVIOUS (NEXT (p)) = p;
+      NEXT (q) = NO_NODE;
+    }
+
+  SUB (p) = z;
+  ATTRIBUTE (p) = t;
+}
+
+/* Find symbol table at level I.  */
+
+static TABLE_T *
+find_level (NODE_T *n, int i)
+{
+  if (n == NO_NODE)
+    return NO_TABLE;
+  else
+    {
+      TABLE_T *s = TABLE (n);
+
+      if (s != NO_TABLE && LEVEL (s) == i)
+	return s;
+      else if ((s = find_level (SUB (n), i)) != NO_TABLE)
+	return s;
+      else if ((s = find_level (NEXT (n), i)) != NO_TABLE)
+	return s;
+      else
+	return NO_TABLE;
+    }
+}
+
+/* Whether P is top of lexical level.  */
+
+bool
+a68_is_new_lexical_level (NODE_T *p)
+{
+  switch (ATTRIBUTE (p))
+    {
+    case ALT_DO_PART:
+    case BRIEF_ELIF_PART:
+    case BRIEF_OUSE_PART:
+    case BRIEF_CONFORMITY_OUSE_PART:
+    case CHOICE:
+    case CLOSED_CLAUSE:
+    case CONDITIONAL_CLAUSE:
+    case DO_PART:
+    case ELIF_PART:
+    case ELSE_PART:
+    case CASE_CLAUSE:
+    case CASE_CHOICE_CLAUSE:
+    case CASE_IN_PART:
+    case CASE_OUSE_PART:
+    case OUT_PART:
+    case ROUTINE_TEXT:
+    case SPECIFIED_UNIT:
+    case THEN_PART:
+    case CONFORMITY_CLAUSE:
+    case CONFORMITY_CHOICE:
+    case CONFORMITY_IN_PART:
+    case CONFORMITY_OUSE_PART:
+    case WHILE_PART:
+      return true;
+    default:
+      return false;
+    }
+}
+
+/*
+ * Couple of utility functions.
+ */
+
+/* Safely append to buffer.  */
+
+void
+a68_bufcat (char *dst, const char *src, int len)
+{
+  if (src != NO_TEXT) {
+    char *d = dst;
+    const char *s = src;
+    int n = len;
+// Find end of dst and left-adjust; do not go past end
+    for (; n-- != 0 && d[0] != '\0'; d++) {
+      ;
+    }
+    int dlen = (int) (d - dst);
+    n = len - dlen;
+    if (n > 0) {
+      while (s[0] != '\0') {
+        if (n != 1) {
+          (d++)[0] = s[0];
+          n--;
+        }
+        s++;
+      }
+      d[0] = '\0';
+    }
+// Better sure than sorry
+    dst[len - 1] = '\0';
+  }
+}
+
+/* Safely copy to buffer.  */
+
+void
+a68_bufcpy (char *dst, const char *src, int len)
+{
+  if (src != NO_TEXT) {
+    char *d = dst;
+    const char *s = src;
+    int n = len;
+// Copy as many as fit
+    if (n > 0 && --n > 0) {
+      do {
+        if (((d++)[0] = (s++)[0]) == '\0') {
+          break;
+        }
+      } while (--n > 0);
+    }
+    if (n == 0 && len > 0) {
+// Not enough room in dst, so terminate
+      d[0] = '\0';
+    }
+// Better sure than sorry
+    dst[len - 1] = '\0';
+  }
+}
+
+/* Make a new copy of concatenated strings.  */
+
+char *
+a68_new_string (const char *t, ...)
+{
+  va_list vl;
+  va_start (vl, t);
+  const char *q = t;
+  if (q == NO_TEXT) {
+    va_end (vl);
+    return NO_TEXT;
+  }
+  int len = 0;
+  while (q != NO_TEXT) {
+    len += (int) strlen (q);
+    q = va_arg (vl, char *);
+  }
+  va_end (vl);
+  len++;
+  char *z = (char *) xmalloc ((size_t) len);
+  z[0] = '\0';
+  q = t;
+  va_start (vl, t);
+  while (q != NO_TEXT) {
+    a68_bufcat (z, q, len);
+    q = va_arg (vl, char *);
+  }
+  va_end (vl);
+  return z;
+}
+
+/*  Tie label to the clause it is defined in.  */
+
+static void
+tie_label_to_serial (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, SERIAL_CLAUSE))
+	{
+	  bool valid_follow;
+
+	  if (NEXT (p) == NO_NODE)
+	    valid_follow = true;
+	  else if (IS (NEXT (p), CLOSE_SYMBOL))
+	    valid_follow = true;
+	  else if (IS (NEXT (p), END_SYMBOL))
+	    valid_follow = true;
+	  else if (IS (NEXT (p), OD_SYMBOL))
+	    valid_follow = true;
+	  else
+	    valid_follow = false;
+
+	  if (valid_follow)
+	    JUMP_TO (TABLE (SUB (p))) = NO_NODE;
+	}
+
+      tie_label_to_serial (SUB (p));
+    }
+}
+
+/* Tie label to the clause it is defined in.  */
+
+static void
+tie_label (NODE_T *p, NODE_T *unit)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, DEFINING_IDENTIFIER))
+	UNIT (TAX (p)) = unit;
+      tie_label (SUB (p), unit);
+    }
+}
+
+/* Tie label to the clause it is defined in.  */
+
+static void
+tie_label_to_unit (NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, LABELED_UNIT))
+	tie_label (SUB_SUB (p), NEXT_SUB (p));
+      tie_label_to_unit (SUB (p));
+    }
+}
+
+/* Table with attribute names.  */
+
+static const char *attribute_names[] =
+{
+  "STOP",
+#define A68_ATTR(ATTR) #ATTR,
+#include "a68-parser-attrs.def"
+#undef A68_ATTR
+};
+
+/* Get the name of an attribute.  */
+
+const char *
+a68_attribute_name (enum a68_attribute attr)
+{
+  return attribute_names[attr];
+}
+
+/* Get the location of node P as a GCC location.  */
+
+location_t
+a68_get_node_location (NODE_T *p)
+{
+  LINE_T *line = LINE (INFO (p));
+
+  if (line == NO_LINE)
+    return UNKNOWN_LOCATION;
+
+  unsigned line_number = NUMBER (line);
+  unsigned column_number = CHAR_IN_LINE (INFO (p)) - STRING (line) + 1;
+  const char *filename = FILENAME (line);
+
+  location_t gcc_location;
+
+  linemap_add (line_table, LC_ENTER, 0, filename, line_number);
+  linemap_line_start (line_table, line_number, 0);
+  gcc_location = linemap_position_for_column (line_table, column_number);
+  linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
+
+  return gcc_location;
+}
+
+/* Get the location of POS inside LINE as a GCC location.  */
+
+location_t
+a68_get_line_location (LINE_T *line, const char *pos)
+{
+  location_t loc;
+
+  linemap_add (line_table, LC_ENTER, 0, FILENAME (line), NUMBER (line));
+  linemap_line_start (line_table, NUMBER (line), 0);
+  loc = linemap_position_for_column (line_table, pos - STRING (line) + 1);
+  linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
+  return loc;
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-postulates.cc
@@ -0,0 +1,103 @@
+/* Postulates needed for improving equivalence of modes.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "a68.h"
+
+/* Initialise use of postulate-lists.  */
+
+void
+a68_init_postulates (void)
+{
+  A68 (top_postulate) = NO_POSTULATE;
+  A68 (top_postulate_list) = NO_POSTULATE;
+}
+
+/* Make old postulates available for new use.  */
+
+void
+a68_free_postulate_list (POSTULATE_T *start, POSTULATE_T *stop)
+{
+  if (start == stop)
+    return;
+
+  POSTULATE_T *last = start;
+  for (; NEXT (last) != stop; FORWARD (last))
+    ;
+
+  NEXT (last) = A68 (top_postulate_list);
+  A68 (top_postulate_list) = start;
+}
+
+/* Add postulates to postulate-list.  */
+
+void
+a68_make_postulate (POSTULATE_T **p, MOID_T *a, MOID_T *b)
+{
+  POSTULATE_T *new_one;
+
+  if (A68 (top_postulate_list) != NO_POSTULATE)
+    {
+      new_one = A68 (top_postulate_list);
+      A68 (top_postulate_list) = A68 (top_postulate_list)->next;
+    }
+  else
+    {
+      new_one = (POSTULATE_T *) xmalloc (sizeof (POSTULATE_T));
+      A68 (new_postulates)++;
+    }
+
+  new_one->a = a;
+  new_one->b = b;
+  new_one->next = *p;
+  *p = new_one;
+}
+
+/* Where postulates are in the list.  */
+
+POSTULATE_T
+*a68_is_postulated_pair (POSTULATE_T *p, MOID_T *a, MOID_T *b)
+{
+  for (; p != NO_POSTULATE; p = p->next)
+    {
+      if (p->a == a && p->b == b)
+	return p;
+    }
+
+  return NO_POSTULATE;
+}
+
+/* Where postulate is in the list.  */
+
+POSTULATE_T
+*a68_is_postulated (POSTULATE_T *p, MOID_T *a)
+{
+  for (; p != NO_POSTULATE; p = p->next)
+    {
+      if (p->a == a)
+	return p;
+    }
+
+  return NO_POSTULATE;
+}
--- /dev/null
+++ b/src/gcc/algol68/a68-tree.def
@@ -0,0 +1,24 @@
+/* This file contains the definitions and documentation for the
+   additional tree codes used in the GNU Algol 68 compiler (see
+   tree.def for the standard codes).
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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/>.  */
+
+/* Tree nodes used in the Algol68 frontend only.  */
+
+/*
+Local variables:
+mode:c
+End:
+*/
--- /dev/null
+++ b/src/gcc/algol68/a68-types.h
@@ -0,0 +1,964 @@
+/* Type definitions for the ALGOL 68 parser.
+   Copyright (C) 2001-2023 J. Marcel van der Veer.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   Original implementation by J. Marcel van der Veer.
+   Adapted for GCC by Jose E. Marchesi.
+
+   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/>.  */
+
+#ifndef __A68_TYPES_H__
+#define __A68_TYPES_H__
+
+#include <setjmp.h>
+#include "vec.h"
+
+/* Enumerations.  */
+
+enum a68_stropping
+{
+  UPPER_STROPPING,
+  SUPPER_STROPPING
+};
+
+enum a68_attribute
+{
+  STOP = 0,
+#define A68_ATTR(ATTR) ATTR,
+#include "a68-parser-attrs.def"
+#undef A68_ATTR
+};
+
+/*
+ * Type definitions.
+ */
+
+typedef char BUFFER[BUFFER_SIZE + 1];
+
+typedef struct MODES_T MODES_T;
+typedef struct NODE_T NODE_T;
+typedef struct MODE_CACHE_T MODE_CACHE_T;
+typedef struct MOID_T MOID_T;
+typedef struct GINFO_T GINFO_T;
+typedef struct KEYWORD_T KEYWORD_T;
+typedef struct LINE_T LINE_T;
+typedef struct NODE_INFO_T NODE_INFO_T;
+typedef struct PACK_T PACK_T;
+typedef struct SOID_T SOID_T;
+typedef struct TABLE_T TABLE_T;
+typedef struct TAG_T TAG_T;
+typedef struct TOKEN_T TOKEN_T;
+typedef struct ORIGIN_T ORIGIN_T;
+typedef struct POSTULATE_T POSTULATE_T;
+typedef struct OPTIONS_T OPTIONS_T;
+typedef struct PARSER_T PARSER_T;
+typedef struct MODULE_T MODULE_T;
+typedef struct A68_T A68_T;
+
+#define NO_A68_REF ((A68_REF *) 0)
+#define NO_ARRAY ((A68_ARRAY *) 0)
+#define NO_BOOK ((BOOK_T *) 0)
+#define NO_BOOL ((bool *) 0)
+#define NO_BYTE ((BYTE_T *) 0)
+#define NO_CONSTANT ((void *) 0)
+#define NO_DEC ((DEC_T *) 0)
+#define NO_EDLIN ((EDLIN_T *) 0)
+#define NO_FILE ((FILE *) 0)
+#define NO_FORMAT ((A68_FORMAT *) 0)
+#define NO_GINFO ((GINFO_T *) 0)
+#define NO_GPROC ((void (*) (NODE_T *)) 0)
+#define NO_HANDLE ((A68_HANDLE *) 0)
+#define NO_INT ((int *) 0)
+#define NO_JMP_BUF ((jmp_buf *) 0)
+#define NO_KEYWORD ((KEYWORD_T *) 0)
+#define NO_NINFO ((NODE_INFO_T *) 0)
+#define NO_NOTE ((void (*) (NODE_T *)) 0)
+#define NO_OPTION_LIST ((OPTION_LIST_T *) 0)
+#define NO_PACK ((PACK_T *) 0)
+#define NO_PPROC ((PROP_T (*) (NODE_T *)) 0)
+#define NO_PROCEDURE ((A68_PROCEDURE *) 0)
+#define NO_REAL ((REAL_T *) 0)
+#define NO_REFINEMENT ((REFINEMENT_T *) 0)
+#define NO_REGMATCH ((regmatch_t *) 0)
+#define NO_SCOPE ((SCOPE_T *) 0)
+#define NO_SOID ((SOID_T *) 0)
+#define NO_STREAM NO_FILE
+#define NO_TEXT ((char *) 0)
+#define NO_TICK ((bool *) 0)
+#define NO_TOKEN ((TOKEN_T *) 0)
+#define NO_TUPLE ((A68_TUPLE *) 0)
+#define NO_VAR (0)
+
+/* A STATUS_MASK_T is a word of flags denoting states.
+
+   Status masks are used in parse tree nodes (NODE_T) and in entries in the
+   symbol table (TAG_T).
+
+
+   SCOPE_ERROR_MASK is used by the static scope checker in order to avoid
+   emitting duplicated scope warnings.  */
+
+typedef uint32_t STATUS_MASK_T;
+
+#define STATUS_CLEAR(p, q) {STATUS (p) &= (~(q));}
+#define STATUS_SET(p, q) {STATUS (p) |= (q);}
+#define STATUS_TEST(p, q) ((STATUS (p) & (q)) != (uint32_t) 0)
+
+#define NULL_MASK                 ((STATUS_MASK_T) 0x00000000)
+#define SCOPE_ERROR_MASK          ((STATUS_MASK_T) 0x00000200)
+
+/* Structure containing the lowering context which is propagated while calling
+   the lowering handlers.  */
+
+struct LOW_CTX_T
+{
+  /* The common declarer in a declaration list.  */
+  NODE_T **declarer;
+  /* The defining identifier of the procedure declaration being processed, or
+     NO_NODE.  This is set by a68_lower_procedure_declaration and used by
+     a68_lower_routine_text.  */
+  NODE_T *proc_decl_identifier;
+  /* For debugging purposes.  */
+  int level;
+};
+
+typedef struct LOW_CTX_T LOW_CTX_T;
+
+/* Type of the lowerer routines defined in a68-low-prelude.cc.  */
+typedef tree (*LOWERER_T) (struct NODE_T *, struct LOW_CTX_T);
+
+#define NO_LOWERER a68_lower_unimplemented
+
+struct KEYWORD_T
+{
+  enum a68_attribute attribute;
+  const char *text;
+  KEYWORD_T *less, *more;
+};
+
+/* A MOID_T represents a mode indicator.
+
+   NUMBER is an unique number assigned to the moid when it gets created.  A
+   renumber_moids function exists in a68-parser-modes.cc but it dosn't seem to
+   be used at all.
+
+   ATTRIBUTE characterizes the kind of mode and is one of the values defined in
+   a68-parser-attrs.def.  Valid values are:
+
+     PROC_SYMBOL for procecure modes.
+     ROWS_SYMBOL for row modes.
+     REF_SYMBOL for reference modes.
+     FLEX_SYMBOL for flexible reference modes.
+     STRUCT_SYMBOL for struct modes.
+     UNION_SYMBOL for union modes.
+     IN_TYPE_MODE for XXX modes.
+     OUT_TYPE_MODE for XXX modes.
+     SERIES_MODE for XXX modes.
+     INDICANT for XXX modes.
+     STANDARD for standard modes.
+
+   NODE is a parse tree node XXX.
+
+   HAS_ROWS is true if the mode contains rows somewhere in its internal
+   structure.
+
+   The interpretation of SUB depends on the kind of mode:
+   - For REF modes it is the referred mode.
+   - For FLEX modes it is the referred mode.
+   - For ROW modes it is the mode of the elements.
+   - For PROC modes it is the mode of the value yielded by the procedure.
+
+   The interpretation of DIM depends on the kind of mode:
+   - In VOID_SYMBOL, STANDARD or INDICANT mode, if DIM is positive it
+     specifies the size of the longsety of the mode.  If DIM is negative then
+     abs (DIM) is the size of hte shortsety of the mode.
+   - In ROW modes, DIM is the number of dimensions.
+   - In STRUCT modes, DIM is the number of fields.
+   - In UNION modes, DIM is the number of united modes.
+   - In PROC_SYMBOL modes, DIM is the number of arguments.
+   - In SERIES_MODE and STOWED_MODE modes, DIM is the number modes.
+
+   SLICE is the mode resulting from slicing a value of this mode.  For example,
+   slicing a M_ROW_INT yields a M_INT.
+
+   EQUIVALENT_MODE (referred as EQUIVALENT), for INDICANTs it is its declarer
+   mode (in MODE FOO = BAR FOO is the indicant and BAR is its declarer) and for
+   STANDARD modes it may be a mode that reflects its structure.
+
+   USE is used by the is_well_formed function, which detects whether a mode is
+   well formed, i.e. that the mode doesn't refer to itself nor it relates to
+   void.
+
+   DEFLEXED_MODE is like the current mode, but without FLEX.  Only defined for
+   modes that have a SUB, i.e. REF, FLEX, ROW and PROC.  In other modes this is
+   NO_MODE.
+
+   For refs to structs, rows or flex, NAME points to the corresponding name
+   mode.  For example, for a mode REF STRUCT (INT i, REAL x), NAME points to a
+   mode STRUCT (REF INT i, REF REAL x).  This is used for selections.
+
+   For rows of structs, rows or flex, MULTIPLE points to the corresponding row
+   mode.  For example, for a mode [] STRUCT (INT i, REAL x), MULTIPLE points to
+   a mode STRUCT ([]INT i, []REAL x).  This is used for selections.
+
+   PACK is a pack of moids.  For a STOWED_MODE, it contains the modes of the
+   arguments of a procedure, or the modes of the units in a collateral clause.
+   For a SERIES_MODE, it contains the modes of the completing units in a serial
+   clause, the alternatives in a conformity clause, the alternatives in a
+   CONDITIONAL_CLAUSE, the alternatives in a CASE_CLAUSE,
+
+   CTYPE is a GCC GENERIC tree corresponding to this mode.  It is computed and
+   installed by a68_lower_moid.  */
+
+#define NO_MOID ((MOID_T *) 0)
+
+struct MOID_T
+{
+  int number;
+  int attribute;
+  int dim;
+  bool has_rows, use, portable, derivate;
+  NODE_T *node;
+  PACK_T *pack;
+  MOID_T *sub, *equivalent_mode, *slice, *deflexed_mode, *name, *multiple_mode, *next, *rowed, *trim;
+  tree ctype;
+};
+
+/* A MODES_T struct contains a collection of particular pre-defined modes.
+
+   These modes are initialized by either stand_moids or make_special_mode.
+   They are commonly referred using the corresponding M_* macros.
+
+   ROWS is a mode to which any ROW mode can be strongly coerced.  It is used as
+   the mode of the second operand of the ELEMS, LWB and UPB operators.
+
+   HIP is the mode of NIL.  */
+
+struct MODES_T
+{
+  MOID_T *BITS, *BOOL, *BYTES, *CHANNEL, *CHAR, *COLLITEM, *COMPL, *COMPLEX,
+    *C_STRING, *ERROR, *FILE, *FORMAT, *HEX_NUMBER, *HIP, *INT, *LONG_BITS, *LONG_BYTES,
+    *LONG_COMPL, *LONG_COMPLEX, *LONG_INT, *LONG_LONG_BITS, *LONG_LONG_COMPL,
+    *LONG_LONG_COMPLEX, *LONG_LONG_INT, *LONG_LONG_REAL, *LONG_REAL, *NUMBER,
+    *PROC_REAL_REAL, *PROC_LONG_REAL_LONG_REAL, *PROC_REF_FILE_BOOL, *PROC_REF_FILE_VOID, *PROC_ROW_CHAR,
+    *PROC_STRING, *PROC_VOID, *REAL, *REF_BITS, *REF_BOOL, *REF_BYTES,
+    *REF_CHAR, *REF_COMPL, *REF_COMPLEX, *REF_FILE, *REF_INT,
+    *REF_LONG_BITS, *REF_LONG_BYTES, *REF_LONG_COMPL, *REF_LONG_COMPLEX,
+    *REF_LONG_INT, *REF_LONG_LONG_BITS, *REF_LONG_LONG_COMPL,
+    *REF_LONG_LONG_COMPLEX, *REF_LONG_LONG_INT, *REF_LONG_LONG_REAL, *REF_LONG_REAL,
+    *REF_REAL, *REF_REF_FILE, *REF_ROW_CHAR, *REF_ROW_COMPLEX, *REF_ROW_INT,
+    *REF_ROW_REAL, *REF_ROW_ROW_COMPLEX, *REF_ROW_ROW_REAL,
+    *REF_SHORT_BITS, *REF_SHORT_SHORT_BITS, *REF_SHORT_INT,
+    *REF_SHORT_SHORT_INT, *REF_STRING,
+    *ROW_BITS, *ROW_BOOL, *ROW_CHAR, *ROW_COMPLEX, *ROW_INT, *ROW_LONG_BITS, *ROW_LONG_LONG_BITS,
+    *ROW_REAL, *ROW_ROW_CHAR, *ROW_ROW_COMPLEX, *ROW_ROW_REAL, *ROWS, *ROW_SIMPLIN, *ROW_SIMPLOUT,
+    *ROW_STRING, *SEMA, *SHORT_BITS, *SHORT_SHORT_BITS, *SHORT_INT, *SHORT_SHORT_INT,
+    *SIMPLIN, *SIMPLOUT, *STRING, *FLEX_ROW_CHAR,
+    *FLEX_ROW_BOOL, *UNDEFINED, *VACUUM, *VOID;
+};
+
+/* The OPTIONS_T structure record which front-end options have been activated.
+   Each option OPTION has a corresponding GCC -f[no-]a68-OPTION command-line
+   switch that can be used to activate or deactivate it.
+
+   STROPPING indicates the stropping regime in use.  It can be UPPER_STROPPING
+   or SUPPER_STROPPING.
+
+   BRACKETS indicates whether [ .. ] and { .. } are equivalent to ( .. ).
+
+   STRICT indicates that no ALGOL 68 extension is allowed.
+
+   ASSERT indicates whether to generate code for assertions.
+
+   BOUNDS_CHECKING indicates whether to perform array bound checking at
+   run-time.
+
+   NIL_CHECKING indicates whether to check for NIL when dereferencing at
+   run-time.  */
+
+struct OPTIONS_T
+{
+  enum a68_stropping stropping;
+  bool brackets;
+  bool strict;
+  bool assert;
+  bool bounds_checking;
+  bool nil_checking;
+};
+
+/* The access class static property of a stored value determines how the value
+   can be reached at run-time.  It is used by the lowering pass in order to
+   minimize copies at run-time.
+
+   CONSTANT is for constant literals.  At run-time these literals will either
+   reside in operand instructions or in space allocated in CONSTAB%.
+
+   DIRIDEN (direct identifier) means that the value is stored on IDST% at some
+   static address.  This is the access class used for values ascribed to
+   identifiers as long as the block in hich they are declared has not been
+   left.  It is also used for values resulting from actions such as the
+   selection from a value possessed by an identifier or the dereferencing fo a
+   name corespodning to a variable.
+
+   VARIDEN (variable identifier) is used for values which are names/variables.
+   The name is stored on IDST%.  The static elaboration of the dereferencing of
+   a variable with access VARIDEN results in a value with access DIRIDEN, not
+   requiring any run-time action.  Same happens with selections of variables of
+   access VARIDEN.
+
+   INDIDEN (indirect identifier) is used for values that are stored in a memory
+   location in IDST%.  The static elaboration of a dereferencing applied to a
+   value of access DIRIDEN.
+
+   DIRWOST (direct working stack) is very much like DIRIDEN, except that the
+   value is stored in WOST% rathern than in IDST%.  This access is used for the
+   result of an action when this result does not preexist in memory and hence
+   has to be constructed in WOST%.
+
+   INDWOST (indirect working stack) is very similar to INDIDEN.  Such an access
+   can be obtained for example through the static elaboration of the
+   dereferencing of a name the access of which is DIRWOST.
+
+   NIHIL is used to characterize the absence of value.  This is used in the
+   static elaboration of a jump, a voiding and a call ith a void result.
+
+   Note that in all these classes we assume as run-time the intermediate
+   language level we are lowering to, i.e. GENERIC.  A DIRIDEN value, for
+   example, can very well stored in a register depending on further compiler
+   optimizations.  */
+
+#define ACCESS_NIHIL 0
+#define ACCESS_CONSTANT 1
+#define ACCESS_DIRIDEN 2
+#define ACCESS_INDIDEN 3
+#define ACCESS_DIRWOST 4
+
+/* A NODE_T is a node in the A68 Syntax tree produced by the lexer-scanner and
+   later expanded by the Mailloux parser.
+
+   NUMBER identifies the node uniquely in the syntax tree.
+
+   ATTRIBUTE is a code that specifies the kind of entity denoted by the node.
+   Valid attributes are defined in the enumeration a68_attribute above in
+   this file.  Examples of attributes are ELIF_PART, GOTO_SYMBOL or BOLD_TAG.
+
+   ANNOTATION provides a way to annotate a node with a reference to another
+   node attribute.  This is currently used by the mode checker to annotate
+   indexer nodes as slicer or as trimmers.
+
+   TYPE (accessed as MOID) is either NO_MOID if the entity denoted by the node
+   doesn't have a mode, or a suitable MOID_T reflecting the mode of the entity.
+   This attribute is calculated and set in all the nodes of the tree by the
+   mode collection and checker pass implemented by make_moid_list.
+
+   INFO contains additional attributes of the node.  See NODE_INFO_T below.
+
+   NEXT, PREVIOUS and SUB are links to other tree nodes.  They are used to link
+   the syntax tree structure from the top:
+
+        TOP <-> N <-> N <-> ...
+                |                      < is PREVIOUS
+		N <-> N <-> ...        > is NEXT
+                      |                | is SUB
+                      N <-> ...
+
+   SEQUENCE is a link to another tree node.  It is used by the tax collector
+   (symbol table builder) in order to handle DO .. OD ranges.
+
+   NEST is a link to another tree node, which is the NEST for the current node.
+   It is set by the tax collector (symbol table builder) and it is used for
+   diagnostics.
+
+   PACK (accessed as NODE_PACK) is either NO_PACK or an instance of the PACK_T
+   structure defined below.  It is used by the modes checker.
+
+   STATUS is a mask of flags, used by several passes that handle nodes.  Valid status flags are:
+
+   SYMBOL_TABLE (accessed as TABLE) is either NO_TABLE or a TABLE_T containing
+   a symbol table introduced by the entity denoted by the tree node.  These
+   nodes are the ones introducing ranges: BEGIN, DO, etc.
+
+   NON_LOCAL is either NO_TABLE, if the environ established by the node is
+   local, or a pointer to a TABLE_T identifying the non-local environment
+   associated with the tree node.  It is set by the static scope checker.  See
+   3.2.2 and 5.2.3.2.b in the report for its application in the handling of
+   local generators in serial clauses.
+
+   TAG (accessed as TAX) is either NO_TAG or a TAG_T used to bind identifier
+   nodes, routine texts and other indicants to their corresponding entry in a
+   symbol table.  This is set by the taxes collector.
+
+   The following fields are static properties managed an used in the lowering
+   pass.
+
+   ORIGIN is a static property that describes the history of the entity denoted
+   by the node.  This is only used in nodes denoting values.
+
+   DYNAMIC_STACK_ALLOCS is a flag used in serial clause nodes.  It determines
+   whether the elaboration of the phrases in the serial clause may involve
+   dynamic stack allocation.  This is used by the lower pass, along with
+   NON_LOCAL above, in order to properly manage the stack pointer while
+   lowering these clauses.
+
+   CDECL is a GCC GENERIC tree corresponding to a DECL_FIELD for FIELD
+   nodes.  */
+
+struct NODE_T
+{
+  GINFO_T *genie;
+  int number;
+  enum a68_attribute attribute;
+  enum a68_attribute annotation;
+  MOID_T *type;
+  NODE_INFO_T *info;
+  NODE_T *next, *previous, *sub;
+  NODE_T *sequence, *nest;
+  PACK_T *pack;
+  STATUS_MASK_T status;
+  TABLE_T *symbol_table;
+  TABLE_T *non_local;
+  TAG_T *tag;
+  tree cdecl;
+  bool dynamic_stack_allocs;
+};
+
+#define NO_NODE ((NODE_T *) 0)
+
+/* A NODE_INFO_T struct contains additional attributes of a NODE_T parse tree
+   node.
+
+   PROCEDURE_LEVEL indicates how lexically deep the tree node is in terms of
+   routine texts.  This attribute is set for all the nodes in the syntax tree
+   by the taxes collector and originally used by ALGOL 68 Genie's monitor.
+   Even if at the moment this is not used by GCC, this field and the
+   correponding machinery is still here in case it is useful in the future.
+
+   PRIORITY (accessed as PRIO) is used by operator tree nodes and specifies the
+   priority of the operator denoted by the node.  This is set tree wide by the
+   bottom-up parser.
+
+   SYMBOL (accessed indirectly as NSYMBOL) contains the symbol value, a string,
+   corresponding to the tree node.  This is used by tree nodes representing
+   tokens such as bold tags, keywords and identifiers.  The symbols are set by
+   the parser-scanner.
+
+   LINE is a pointer to the source line from which the tree node originates.
+   This is set for tree nodes representing tokens and is set by the
+   parser-scanner.  */
+
+struct NODE_INFO_T
+{
+  int procedure_level;
+  int priority;
+  char *char_in_line;
+  int pragment_type;
+  char *pragment;
+  const char *symbol;
+  LINE_T *line;
+};
+
+struct GINFO_T
+{
+  MOID_T *partial_proc, *partial_locale;
+};
+
+struct PACK_T
+{
+  MOID_T *type;
+  const char *text;
+  NODE_T *node;
+  PACK_T *next, *previous;
+};
+
+/* Postulates.  */
+
+struct POSTULATE_T
+{
+  MOID_T *a, *b;
+  POSTULATE_T *next;
+};
+
+#define NO_POSTULATE ((POSTULATE_T *) 0)
+
+struct SOID_T
+{
+  int attribute, sort, cast;
+  MOID_T *type;
+  NODE_T *node;
+  SOID_T *next;
+};
+
+struct LINE_T
+{
+  char marker[6], *string;
+  const char *filename;
+  int number;
+  LINE_T *next, *previous;
+};
+#define NO_LINE ((LINE_T *) 0)
+
+struct TABLE_T
+{
+  int num, level, nest, attribute;
+  bool initialise_frame, initialise_anon, proc_ops;
+  TABLE_T *previous, *outer;
+  TAG_T *identifiers, *operators, *priority, *indicants, *labels, *anonymous;
+  NODE_T *jump_to, *sequence;
+};
+#define NO_TABLE ((TABLE_T *) 0)
+
+/* A TAG_T structure denotes an entry in the symbol table.  Each entry
+   corresponds to an identity.
+
+   TAX: TAG; TAB; TAD; TAM;
+
+   TYPE is the mode of the entry.
+
+   NODE is the defining identifier associated to the declaration.
+
+   SCOPE is the lexical depth of the tag.  Zero corresponds to the primal
+   scope.  It is set by the static scope checker.
+
+   SCOPE_ASSIGNED determines whether a SCOPE has been actually assigned to the
+   tag.  It is set by the static scope checker.  The entities which get
+   assigned scopes are identities of format texts and routine texts.
+
+   PORTABLE determines whether the construction associated with the tag is
+   Algol 68 or some extension.
+
+   VARIABLE is set when the defining identifier in NODE is defined in a
+   variable declaration, as opposed to an identity declaration.  This is set by
+   extract_variables and is used by the lowering pass.
+
+   HEAP is used for defining identifier in NODE is defined in a variable
+   declaration.  It is HEAP_SYMBOL or LOC_SYMBOL.
+
+   IS_RECURSIVE is set for mode indicants whose definition is recursive,
+   i.e. they appear in actual declarers within its own definition.
+
+   ASCRIBED_ROUTINE_TEXT is set when the defining identifier is ascribed a
+   routine-text in an identity declaration.
+
+   IN_PROC is set when the defining identifier has been set in a
+   proc-identity-declaration or in a brief-op-declaration.
+
+   YOUNGEST_ENVIRON is used when NODE is either a ROUTINE_TEXT or a
+   FORMAT_TEXT, and contains the youngest (higher) lexical level of any object
+   directly declared in the routine or format body.  This is filled in and used
+   by the scope checker.
+
+   TREE_DECL is the GENERIC declaration for the definition of this symbol.
+   This is set and used by the lower pass.  For mode indicants, it contains a
+   function that generates a pointer to the given mode, and is used by
+   a68_low_generator to handle recursive modes.
+
+   LOWERER is a lowering routine defined in a68-low-prelude.cc.  These are used
+   in taxes that denote some pre-defined operator.  */
+
+struct TAG_T
+{
+  TABLE_T *symbol_table;
+  MOID_T *type;
+  NODE_T *node, *unit;
+  char *value;
+  bool scope_assigned, use, in_proc, loc_assigned, portable, variable;
+  bool ascribed_routine_text, is_recursive;
+  int priority, heap, scope, youngest_environ, number;
+  STATUS_MASK_T status;
+  tree tree_decl;
+  LOWERER_T lowerer;
+  TAG_T *next, *body;
+};
+#define NO_TAG ((TAG_T *) 0)
+
+struct TOKEN_T
+{
+  char *text;
+  TOKEN_T *less, *more;
+};
+#define NO_TOKEN ((TOKEN_T *) 0)
+
+struct MODULE_T
+{
+  bool tree_listing_safe, cross_reference_safe;
+  int error_count, warning_count, source_scan;
+  LINE_T *top_line;
+  MOID_T *top_moid, *standenv_moid;
+  NODE_T *top_node;
+  OPTIONS_T options;
+  FILE *file_source_fd;
+  const char *file_source_name;
+  struct
+  {
+    LINE_T *save_l;
+    char *save_s, save_c;
+  } scan_state;
+};
+
+struct MODE_CACHE_T
+{
+  MOID_T *proc_bool;
+  MOID_T *proc_char;
+  MOID_T *proc_complex_complex;
+  MOID_T *proc_int;
+  MOID_T *proc_int_int;
+  MOID_T *proc_int_int_real;
+  MOID_T *proc_int_real;
+  MOID_T *proc_int_real_real;
+  MOID_T *proc_int_real_real_real;
+  MOID_T *proc_real;
+  MOID_T *proc_real_int_real;
+  MOID_T *proc_real_real;
+  MOID_T *proc_real_real_int_real;
+  MOID_T *proc_real_real_real;
+  MOID_T *proc_real_real_real_int;
+  MOID_T *proc_real_real_real_real;
+  MOID_T *proc_real_real_real_real_real;
+  MOID_T *proc_real_real_real_real_real_real;
+  MOID_T *proc_real_ref_real_ref_int_void;
+  MOID_T *proc_void;
+};
+
+/* A PARSER_T struct contains all the global state that is kept by the parser.
+   This information is managed and used exclusively by a68_parser.
+
+   ERROR_TAG is a tag that signifies an error.  It is initialized in
+   a68_parser.
+
+   STOP_SCANNER is a control flag used exclusively by the main loop in
+   tokenise_source, which is recursive.
+
+   SCAN_BUF is a scratch buffer used by the scanner for several purposes.  This
+   buffer is known to be big enough to hold any substring from the source file.
+   It is initialized in read_source_file.
+
+   MAX_SCAN_BUF_LENGTH is the useable size of SCAN_BUF.  This is used by the
+   scanner to grow SCAN_BUF as it includes other files.
+
+   TAG_NUMBER is a global counter used by the parser to assign an unique number
+   to each tag it creates.  It is used in a68_new_tag.
+
+   BOTTOM_UP_CRASH_EXIT and TOP_DOWN_CRASH_EXIT are used to longjmp from deeply
+   nested errors in the bottom-up and top-down parsers respectively.  */
+
+struct PARSER_T
+{
+  TAG_T *error_tag;
+  bool stop_scanner;
+  size_t max_scan_buf_length;
+  char *scan_buf;
+  int tag_number;
+  jmp_buf bottom_up_crash_exit;
+  jmp_buf top_down_crash_exit;
+};
+
+/* A A68_T struct contains the global state used by the ALGOL 68 front-end.
+
+   OUTPUT_LINE is used by the diagnostics machinery in order to write out
+   message lines.
+
+   EDIT_LINE is used as a scratch buffer for composing error messages and the
+   like.
+
+   INPUT_LINE is used by the original ALGOL 68 Genie to read lines from the
+   tty.  But in this parser it is used uninitialized (!) by the
+   a68_phrase_to_text routine in the top-down parser.  XXX.
+
+   NEW_NODES is a global counter that keeps the number of parse tree nodes
+   created.  It is currently not used for anything, but still updated in
+   a68_new_node.
+
+   NEW_MODES is a global counter that keeps the number of moids created.  It is
+   currently not used for anything, but still updated in a68_new_moid.
+
+   NEW_POSTULATES is a global counter that keeps the number of postulates
+   created by the front-end.  It is currently not used for anything, but still
+   updated in a68_make_postulate.
+
+   NEW_NODE_INFOS is a global counter that keeps the number of NODE_INFO_T
+   structures created by the front-end.  It is currently not used for anything,
+   but still updated in a68_new_node_info.
+
+   NEW_GENIE_INFOS is a global counter that keeps the number of GINFO_T
+   structures created by the front-end.  It is currently no tused for anything,
+   but still updated in a68_new_genie_info.
+
+   SYMBOL_TABLE_COUNT is a global counter used by the parser.  XXX move to
+   parser global state when syntax tree finalisation is moved to a68_parser?
+
+   MODE_COUNT is the number of modes registered in the global modes table. XXX
+   which table.
+
+   TOP_KEYWORD is the top of the list of keywords known to the font-end.
+
+   MODE_CACHE XXX.
+
+   A68_MODES (accessed as MODE) is a collection of particular pre-defined
+   modes.  These modes are initialized by stand_moids.
+
+   JOB (accessed as A68_JOB) is the instance of MODULE_T with the global data
+   corresponding to the source file being compiled.
+
+   OPTIONS is the set of options currently set for the front-end.
+
+   TOP_POSTULATE and TOP_POSTULATE_LIST are lists of postulates maintained by
+   the front-end.
+
+   POSTULATES is a collection of postulates used by the moid pretty printer.
+
+   TOP_SOID_LIST is used by the moid machinery.
+
+   STANDENV XXX.
+
+   TOP_TOKEN XXX.
+
+   INCLUDE_PATHS is the list of paths where we search for files to include.
+   Directories are added to the list at the option handling language hook.
+   The list is searched in FIFO order.
+*/
+
+struct A68_T
+{
+  BUFFER output_line;
+  BUFFER edit_line;
+  BUFFER input_line;
+  int new_nodes;
+  int new_modes;
+  int new_postulates;
+  int new_node_infos;
+  int new_genie_infos;
+  int symbol_table_count;
+  int mode_count;
+  KEYWORD_T *top_keyword;
+  MODE_CACHE_T mode_cache;
+  MODES_T a68_modes;
+  MODULE_T job;
+  OPTIONS_T *options;
+  POSTULATE_T *postulates, *top_postulate, *top_postulate_list;
+  SOID_T *top_soid_list;
+  TABLE_T *standenv;
+  TOKEN_T *top_token;
+  vec<const char *, va_heap, vl_embed> *include_paths;
+};
+
+/*
+ * Access macros to fields in the struct types defined above.  These are used *
+ * in order to achieve a nice ALGOL-like field OF struct style.
+ */
+
+#define BACKWARD(p) (p = PREVIOUS (p))
+#define DEFLEX(p) (DEFLEXED (p) != NO_MOID ? DEFLEXED(p) : (p))
+#define FORWARD(p) ((p) = NEXT (p))
+#define A(p) ((p)->a)
+#define ANNOTATION(p) ((p)->annotation)
+#define ANONYMOUS(p) ((p)->anonymous)
+#define ATTRIBUTE(p) ((p)->attribute)
+#define ASCRIBED_ROUTINE_TEXT(p) ((p)->ascribed_routine_text)
+#define B(p) ((p)->b)
+#define BODY(p) ((p)->body)
+#define CAST(p) ((p)->cast)
+#define CHAR_IN_LINE(p) ((p)->char_in_line)
+#define CROSS_REFERENCE_SAFE(p) ((p)->cross_reference_safe)
+#define CDECL(p) ((p)->cdecl)
+#define CTYPE(p) ((p)->ctype)
+#define DEFLEXED(p) ((p)->deflexed_mode)
+#define DEREFO(p) ((p).derefo)
+#define DERIVATE(p) ((p)->derivate)
+#define DIM(p) ((p)->dim)
+#define DYNAMIC_STACK_ALLOCS(p) ((p)->dynamic_stack_allocs)
+#define EQUIVALENT(p) ((p)->equivalent_mode)
+#define EQUIVALENT_MODE(p) ((p)->equivalent_mode)
+#define ERROR_COUNT(p) ((p)->error_count)
+#define WARNING_COUNT(p) ((p)->warning_count)
+#define F(p) ((p)->f)
+#define FILENAME(p) ((p)->filename)
+#define FILE_SOURCE_FD(p) ((p)->file_source_fd)
+#define FILE_SOURCE_NAME(p) ((p)->file_source_name)
+#define FLEXO(p) ((p).flexo)
+#define FLEXO_KNOWN(p) ((p).flexo_known)
+#define G(p) ((p)->g)
+#define GINFO(p) ((p)->genie)
+#define GENO(p) ((p).geno)
+#define GET(p) ((p)->get)
+#define GPARENT(p) (PARENT (GINFO (p)))
+#define GREEN(p) ((p)->green)
+#define H(p) ((p)->h)
+#define HANDLE(p) ((p)->handle)
+#define HAS_ROWS(p) ((p)->has_rows)
+#define HEAP(p) ((p)->heap)
+#define ID(p) ((p)->id)
+#define IDENTIFICATION(p) ((p)->identification)
+#define IDENTIFIERS(p) ((p)->identifiers)
+#define IDF(p) ((p)->idf)
+#define IM(z) (VALUE (&(z)[1]))
+#define IN(p) ((p)->in)
+#define INDEX(p) ((p)->index)
+#define INDICANTS(p) ((p)->indicants)
+#define INFO(p) ((p)->info)
+#define INITIALISE_ANON(p) ((p)->initialise_anon)
+#define INITIALISE_FRAME(p) ((p)->initialise_frame)
+#define INI_PTR(p) ((p)->ini_ptr)
+#define INS_MODE(p) ((p)->ins_mode)
+#define IN_FORBIDDEN(p) ((p)->in_forbidden)
+#define IN_PREFIX(p) ((p)->in_prefix)
+#define IN_PROC(p) ((p)->in_proc)
+#define IN_TEXT(p) ((p)->in_text)
+#define IS_OPEN(p) ((p)->is_open)
+#define IS_RECURSIVE(p) ((p)->is_recursive)
+#define IS_TMP(p) ((p)->is_tmp)
+#define JUMP_STAT(p) ((p)->jump_stat)
+#define JUMP_TO(p) ((p)->jump_to)
+#define K(q) ((q)->k)
+#define LABELS(p) ((p)->labels)
+#define LAST(p) ((p)->last)
+#define LAST_LINE(p) ((p)->last_line)
+#define LESS(p) ((p)->less)
+#define LEVEL(p) ((p)->level)
+#define LEX_LEVEL(p) (LEVEL (TABLE (p)))
+#define LINBUF(p) ((p)->linbuf)
+#define LINE(p) ((p)->line)
+#define LINE_APPLIED(p) ((p)->line_applied)
+#define LINE_DEFINED(p) ((p)->line_defined)
+#define LINE_END_MENDED(p) ((p)->line_end_mended)
+#define LINE_NUMBER(p) (NUMBER (LINE (INFO (p))))
+#define LINSIZ(p) ((p)->linsiz)
+#define LIST(p) ((p)->list)
+#define ln(x) (log (x))
+#define LOCALE(p) ((p)->locale)
+#define LOC_ASSIGNED(p) ((p)->loc_assigned)
+#define LOWERER(p) ((p)->lowerer)
+#define LOWER_BOUND(p) ((p)->lower_bound)
+#define LWB(p) ((p)->lower_bound)
+#define MARKER(p) ((p)->marker)
+#define MATCH(p) ((p)->match)
+#define MODIFIED(p) ((p)->modified)
+#define MOID(p) ((p)->type)
+#define MORE(p) ((p)->more)
+#define MSGS(p) ((p)->msgs)
+#define MULTIPLE(p) ((p)->multiple_mode)
+#define MULTIPLE_MODE(p) ((p)->multiple_mode)
+#define NAME(p) ((p)->name)
+#define NEST(p) ((p)->nest)
+#define NEXT(p) ((p)->next)
+#define NEXT_NEXT(p) (NEXT (NEXT (p)))
+#define NEXT_NEXT_NEXT(p) (NEXT (NEXT_NEXT (p)))
+#define NEXT_SUB(p) (NEXT (SUB (p)))
+#define NF(p) ((p)->nf)
+#define NILO(p) ((p).nilo)
+#define NILO_KNOWN(p) ((p).nilo_known)
+#define NODE(p) ((p)->node)
+#define NODE_DEFINED(p) ((p)->node_defined)
+#define NODE_PACK(p) ((p)->pack)
+#define NON_LOCAL(p) ((p)->non_local)
+#define NCHAR_IN_LINE(p) (CHAR_IN_LINE (INFO (p)))
+#define NPRAGMENT(p) (PRAGMENT (INFO (p)))
+#define NPRAGMENT_TYPE(p) (PRAGMENT_TYPE (INFO (p)))
+#define NSYMBOL(p) (SYMBOL (INFO (p)))
+#define NUM(p) ((p)->num)
+#define NUMBER(p) ((p)->number)
+#define OPER(p) ((p)->oper)
+#define OPERATORS(p) ((p)->operators)
+#define OPT(p) ((p)->opt)
+#define OPTIONS(p) ((p)->options)
+#define OPTION_ASSERT(p) (OPTIONS (p).assert)
+#define OPTION_BOUNDS_CHECKING(p) (OPTIONS (p).bounds_checking)
+#define OPTION_BRACKETS(p) (OPTIONS (p).brackets)
+#define OPTION_NIL_CHECKING(p) (OPTIONS (p).nil_checking)
+#define OPTION_STRICT(p) (OPTIONS (p).strict)
+#define OPTION_STROPPING(p) (OPTIONS (p).stropping)
+#define OPTION_LIST(p) (OPTIONS (p).list)
+#define OPTION_LOCAL(p) (OPTIONS (p).local)
+#define OPTION_NODEMASK(p) (OPTIONS (p).nodemask)
+#define OUT(p) ((p)->out)
+#define OUTER(p) ((p)->outer)
+#define P(q) ((q)->p)
+#define PACK(p) ((p)->pack)
+#define PARTIAL_LOCALE(p) ((p)->partial_locale)
+#define PARTIAL_PROC(p) ((p)->partial_proc)
+#define PORTABLE(p) ((p)->portable)
+#define PRAGMENT(p) ((p)->pragment)
+#define PRAGMENT_TYPE(p) ((p)->pragment_type)
+#define PREVIOUS(p) ((p)->previous)
+#define PRIO(p) ((p)->priority)
+#define PROCEDURE_LEVEL(p) ((p)->procedure_level)
+#define PROC_OPS(p) ((p)->proc_ops)
+#define R(p) ((p)->r)
+#define RE(z) (VALUE (&(z)[0]))
+#define ROWED(p) ((p)->rowed)
+#define SCAN_STATE_C(p) ((p)->scan_state.save_c)
+#define SCAN_STATE_L(p) ((p)->scan_state.save_l)
+#define SCAN_STATE_S(p) ((p)->scan_state.save_s)
+#define SCOPE(p) ((p)->scope)
+#define SCOPE_ASSIGNED(p) ((p)->scope_assigned)
+#define SEQUENCE(p) ((p)->sequence)
+#define SEVERITY(p) ((p)->severity)
+#define SLICE(p) ((p)->slice)
+#define SORT(p) ((p)->sort)
+#define SOURCE_SCAN(p) ((p)->source_scan)
+#define STANDENV_MOID(p) ((p)->standenv_moid)
+#define STATUS(p) ((p)->status)
+#define STRING(p) ((p)->string)
+#define SUB(p) ((p)->sub)
+#define SUB_MOID(p) (SUB (MOID (p)))
+#define SUB_NEXT(p) (SUB (NEXT (p)))
+#define SUB_SUB(p) (SUB (SUB (p)))
+#define SYMBOL(p) ((p)->symbol)
+#define TABLE(p) ((p)->symbol_table)
+#define TAG_LEX_LEVEL(p) (LEVEL (TAG_TABLE (p)))
+#define TAG_TABLE(p) ((p)->symbol_table)
+#define TAX(p) ((p)->tag)
+#define TAX_TREE_DECL(p) ((p)->tree_decl)
+#define TEXT(p) ((p)->text)
+#define TOP_LINE(p) ((p)->top_line)
+#define TOP_MOID(p) ((p)->top_moid)
+#define TOP_NODE(p) ((p)->top_node)
+#define TRANSIENT(p) ((p)->transient)
+#define TREE_LISTING_SAFE(p) ((p)->tree_listing_safe)
+#define TRIM(p) ((p)->trim)
+#define TUPLE(p) ((p)->tuple)
+#define UNIT(p) ((p)->unit)
+#define USE(p) ((p)->use)
+#define VALUE(p) ((p)->value)
+#define VARIABLE(p) ((p)->variable)
+#define WHERE(p) ((p)->where)
+#define IS_FLEXETY_ROW(m) (IS_FLEX (m) || IS_ROW (m) || m == M_STRING)
+#define IS_FLEX(m) IS ((m), FLEX_SYMBOL)
+#define IS_LITERALLY(p, s) (strcmp (NSYMBOL (p), s) == 0)
+#define ISNT(p, s) (! IS (p, s))
+#define IS(p, s) (ATTRIBUTE (p) == (s))
+#define IS_REF_FLEX(m) (IS (m, REF_SYMBOL) && IS (SUB (m), FLEX_SYMBOL))
+#define IS_REF(m) IS ((m), REF_SYMBOL)
+#define IS_INTEGRAL(m)					  \
+  ((m) == M_INT						  \
+   || (m) == M_LONG_INT					  \
+   || (m) == M_LONG_LONG_INT				  \
+   || (m) == M_SHORT_INT				  \
+   || (m) == M_SHORT_SHORT_INT)
+#define IS_BITS(m)						  \
+  ((m) == M_BITS						  \
+   || (m) == M_LONG_BITS					  \
+   || (m) == M_LONG_LONG_BITS					  \
+   || (m) == M_SHORT_BITS					  \
+   || (m) == M_SHORT_SHORT_BITS)
+#define IS_REAL(m)				\
+  ((m) == M_REAL				\
+   || (m) == M_LONG_REAL			\
+   || (m) == M_LONG_LONG_REAL)
+#define IS_ROW(m) IS ((m), ROW_SYMBOL)
+#define IS_STRUCT(m) IS ((m), STRUCT_SYMBOL)
+#define IS_UNION(m) IS ((m), UNION_SYMBOL)
+#define YOUNGEST_ENVIRON(p) ((p)->youngest_environ)
+
+#endif /* ! __A68_TYPES_H */
--- /dev/null
+++ b/src/gcc/algol68/a68-unistr.c
@@ -0,0 +1,453 @@
+/* Character conversion functions for the Algol 68 front-end.
+   Copyright (C) 1999-2002, 2006-2007, 2009-2024 Free Software Foundation, Inc.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   The code in this file has been adapted from the unistr gnulib module,
+   written by Bruno Haible.
+  
+   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/>.  */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "a68.h"
+
+static int
+u8_mbtoucr (uint32_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+        {
+          if (n >= 2)
+            {
+              if ((s[1] ^ 0x80) < 0x40)
+                {
+                  *puc = ((unsigned int) (c & 0x1f) << 6)
+                         | (unsigned int) (s[1] ^ 0x80);
+                  return 2;
+                }
+              /* invalid multibyte character */
+            }
+          else
+            {
+              /* incomplete multibyte character */
+              *puc = 0xfffd;
+              return -2;
+            }
+        }
+      else if (c < 0xf0)
+        {
+          if (n >= 2)
+            {
+              if ((s[1] ^ 0x80) < 0x40
+                  && (c >= 0xe1 || s[1] >= 0xa0)
+                  && (c != 0xed || s[1] < 0xa0))
+                {
+                  if (n >= 3)
+                    {
+                      if ((s[2] ^ 0x80) < 0x40)
+                        {
+                          *puc = ((unsigned int) (c & 0x0f) << 12)
+                                 | ((unsigned int) (s[1] ^ 0x80) << 6)
+                                 | (unsigned int) (s[2] ^ 0x80);
+                          return 3;
+                        }
+                      /* invalid multibyte character */
+                    }
+                  else
+                    {
+                      /* incomplete multibyte character */
+                      *puc = 0xfffd;
+                      return -2;
+                    }
+                }
+              /* invalid multibyte character */
+            }
+          else
+            {
+              /* incomplete multibyte character */
+              *puc = 0xfffd;
+              return -2;
+            }
+        }
+      else if (c <= 0xf4)
+        {
+          if (n >= 2)
+            {
+              if ((s[1] ^ 0x80) < 0x40
+                  && (c >= 0xf1 || s[1] >= 0x90)
+                  && (c < 0xf4 || (/* c == 0xf4 && */ s[1] < 0x90)))
+                {
+                  if (n >= 3)
+                    {
+                      if ((s[2] ^ 0x80) < 0x40)
+                        {
+                          if (n >= 4)
+                            {
+                              if ((s[3] ^ 0x80) < 0x40)
+                                {
+                                  *puc = ((unsigned int) (c & 0x07) << 18)
+                                         | ((unsigned int) (s[1] ^ 0x80) << 12)
+                                         | ((unsigned int) (s[2] ^ 0x80) << 6)
+                                         | (unsigned int) (s[3] ^ 0x80);
+                                  return 4;
+                                }
+                              /* invalid multibyte character */
+                            }
+                          else
+                            {
+                              /* incomplete multibyte character */
+                              *puc = 0xfffd;
+                              return -2;
+                            }
+                        }
+                      /* invalid multibyte character */
+                    }
+                  else
+                    {
+                      /* incomplete multibyte character */
+                      *puc = 0xfffd;
+                      return -2;
+                    }
+                }
+              /* invalid multibyte character */
+            }
+          else
+            {
+              /* incomplete multibyte character */
+              *puc = 0xfffd;
+              return -2;
+            }
+        }
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return -1;
+}
+
+/* Get the UCS code for the first character of a given UTF-8 string.  */
+
+int
+a68_u8_mbtouc (uint32_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+        {
+          if (n >= 2)
+            {
+              if ((s[1] ^ 0x80) < 0x40)
+                {
+                  *puc = ((unsigned int) (c & 0x1f) << 6)
+                         | (unsigned int) (s[1] ^ 0x80);
+                  return 2;
+                }
+              /* invalid multibyte character */
+            }
+          else
+            {
+              /* incomplete multibyte character */
+              *puc = 0xfffd;
+              return 1;
+            }
+        }
+      else if (c < 0xf0)
+        {
+          if (n >= 3)
+            {
+              if ((s[1] ^ 0x80) < 0x40
+                  && (c >= 0xe1 || s[1] >= 0xa0)
+                  && (c != 0xed || s[1] < 0xa0))
+                {
+                  if ((s[2] ^ 0x80) < 0x40)
+                    {
+                      *puc = ((unsigned int) (c & 0x0f) << 12)
+                             | ((unsigned int) (s[1] ^ 0x80) << 6)
+                             | (unsigned int) (s[2] ^ 0x80);
+                      return 3;
+                    }
+                  /* invalid multibyte character */
+                  *puc = 0xfffd;
+                  return 2;
+                }
+              /* invalid multibyte character */
+              *puc = 0xfffd;
+              return 1;
+            }
+          else
+            {
+              *puc = 0xfffd;
+              if (n == 1)
+                {
+                  /* incomplete multibyte character */
+                  return 1;
+                }
+              else
+                {
+                  if ((s[1] ^ 0x80) < 0x40
+                      && (c >= 0xe1 || s[1] >= 0xa0)
+                      && (c != 0xed || s[1] < 0xa0))
+                    {
+                      /* incomplete multibyte character */
+                      return 2;
+                    }
+                  else
+                    {
+                      /* invalid multibyte character */
+                      return 1;
+                    }
+                }
+            }
+        }
+      else if (c <= 0xf4)
+        {
+          if (n >= 4)
+            {
+              if ((s[1] ^ 0x80) < 0x40
+                  && (c >= 0xf1 || s[1] >= 0x90)
+                  && (c < 0xf4 || (/* c == 0xf4 && */ s[1] < 0x90)))
+                {
+                  if ((s[2] ^ 0x80) < 0x40)
+                    {
+                      if ((s[3] ^ 0x80) < 0x40)
+                        {
+                          *puc = ((unsigned int) (c & 0x07) << 18)
+                                 | ((unsigned int) (s[1] ^ 0x80) << 12)
+                                 | ((unsigned int) (s[2] ^ 0x80) << 6)
+                                 | (unsigned int) (s[3] ^ 0x80);
+                          return 4;
+                        }
+                      /* invalid multibyte character */
+                      *puc = 0xfffd;
+                      return 3;
+                    }
+                  /* invalid multibyte character */
+                  *puc = 0xfffd;
+                  return 2;
+                }
+              /* invalid multibyte character */
+              *puc = 0xfffd;
+              return 1;
+            }
+          else
+            {
+              *puc = 0xfffd;
+              if (n == 1)
+                {
+                  /* incomplete multibyte character */
+                  return 1;
+                }
+              else
+                {
+                  if ((s[1] ^ 0x80) < 0x40
+                      && (c >= 0xf1 || s[1] >= 0x90)
+                      && (c < 0xf4 || (/* c == 0xf4 && */ s[1] < 0x90)))
+                    {
+                      if (n == 2)
+                        {
+                          /* incomplete multibyte character */
+                          return 2;
+                        }
+                      else
+                        {
+                          if ((s[2] ^ 0x80) < 0x40)
+                            {
+                              /* incomplete multibyte character */
+                              return 3;
+                            }
+                          else
+                            {
+                              /* invalid multibyte character */
+                              return 2;
+                            }
+                        }
+                    }
+                  else
+                    {
+                      /* invalid multibyte character */
+                      return 1;
+                    }
+                }
+            }
+        }
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return 1;
+}
+
+/* Encode a given UCS code in UTF-8.  */
+
+int
+a68_u8_uctomb (uint8_t *s, uint32_t uc, ptrdiff_t n)
+{
+  if (uc < 0x80)
+    {
+      if (n > 0)
+        {
+          s[0] = uc;
+          return 1;
+        }
+      /* else return -2, below.  */
+    }
+  else
+    {
+      int count;
+
+      if (uc < 0x800)
+        count = 2;
+      else if (uc < 0x10000)
+        {
+          if (uc < 0xd800 || uc >= 0xe000)
+            count = 3;
+          else
+            return -1;
+        }
+      else if (uc < 0x110000)
+        count = 4;
+      else
+        return -1;
+
+      if (n >= count)
+        {
+          switch (count) /* note: code falls through cases! */
+            {
+            case 4: s[3] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x10000;
+              gcc_fallthrough ();
+            case 3: s[2] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x800;
+              gcc_fallthrough ();
+            case 2: s[1] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0xc0;
+          /*case 1:*/ s[0] = uc;
+            }
+          return count;
+        }
+    }
+  return -2;
+}
+
+/* Convert UTF-8 to UTF-32/UCS-4  */
+
+uint32_t *
+a68_u8_to_u32 (const uint8_t *s, size_t n, uint32_t *resultbuf, size_t *lengthp)
+{
+  const uint8_t *s_end = s + n;
+  /* Output string accumulator.  */
+  uint32_t *result;
+  size_t allocated;
+  size_t length;
+
+  if (resultbuf != NULL)
+    {
+      result = resultbuf;
+      allocated = *lengthp;
+    }
+  else
+    {
+      result = NULL;
+      allocated = 0;
+    }
+  length = 0;
+  /* Invariants:
+     result is either == resultbuf or == NULL or malloc-allocated.
+     If length > 0, then result != NULL.  */
+
+  while (s < s_end)
+    {
+      uint32_t uc;
+      int count;
+
+      /* Fetch a Unicode character from the input string.  */
+      count = u8_mbtoucr (&uc, s, s_end - s);
+      if (count < 0)
+        {
+          if (!(result == resultbuf || result == NULL))
+            free (result);
+          errno = EILSEQ;
+          return NULL;
+        }
+      s += count;
+
+      /* Store it in the output string.  */
+      if (length + 1 > allocated)
+        {
+          uint32_t *memory;
+
+          allocated = (allocated > 0 ? 2 * allocated : 12);
+          if (length + 1 > allocated)
+            allocated = length + 1;
+          if (result == resultbuf || result == NULL)
+            memory = (uint32_t *) xmalloc (allocated * sizeof (uint32_t));
+          else
+            memory =
+              (uint32_t *) xrealloc (result, allocated * sizeof (uint32_t));
+
+          if (memory == NULL)
+            {
+              if (!(result == resultbuf || result == NULL))
+                free (result);
+              errno = ENOMEM;
+              return NULL;
+            }
+          if (result == resultbuf && length > 0)
+            memcpy ((char *) memory, (char *) result,
+                    length * sizeof (uint32_t));
+          result = memory;
+        }
+      result[length++] = uc;
+    }
+
+  if (length == 0)
+    {
+      if (result == NULL)
+        {
+          /* Return a non-NULL value.  NULL means error.  */
+          result = (uint32_t *) xmalloc (sizeof (uint32_t));
+          if (result == NULL)
+            {
+              errno = ENOMEM;
+              return NULL;
+            }
+        }
+    }
+  else if (result != resultbuf && length < allocated)
+    {
+      /* Shrink the allocated memory if possible.  */
+      uint32_t *memory;
+
+      memory = (uint32_t *) xrealloc (result, length * sizeof (uint32_t));
+      if (memory != NULL)
+        result = memory;
+    }
+
+  *lengthp = length;
+  return result;
+}
--- /dev/null
+++ b/src/gcc/algol68/a68.h
@@ -0,0 +1,1042 @@
+/* Definitions for the Algol 68 GCC front end.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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/>.  */
+
+#ifndef __A68_H__
+#define __A68_H__
+
+/* Some common definitions first.  */
+
+#define BUFFER_SIZE 1024
+#define SMALL_BUFFER_SIZE 128
+#define SNPRINTF_SIZE ((size_t) (BUFFER_SIZE - 1))
+#define BUFCLR(z) {memset ((z), 0, BUFFER_SIZE + 1);}
+#define MOID_ERROR_WIDTH 80
+
+#define MONADS "%^&+-~!?"
+#define NOMADS "></=*"
+
+/* Maximum number of priorities supported for operators.  The Algol 68 RR
+   specifies 9.  */
+
+#define MAX_PRIORITY 9
+
+/* The primal scope is the top-level scope.  */
+
+#define PRIMAL_SCOPE 0
+
+/* Deflexing strategy.  See the moid checking routines in
+   a68-parser-moids-check for an explanation of these values.  */
+
+enum
+{
+  NO_DEFLEXING = 1, SAFE_DEFLEXING, ALIAS_DEFLEXING, FORCE_DEFLEXING,
+  SKIP_DEFLEXING
+};
+
+/* Then the types.  */
+
+#include "a68-types.h"
+
+/* Front-end global state.  */
+
+extern A68_T a68_common;
+#define A68(z)             (a68_common.z)
+#define A68_JOB            A68 (job)
+#define A68_STANDENV       A68 (standenv)
+#define A68_MCACHE(z)      A68 (mode_cache.z)
+#define A68_INCLUDE_PATHS  A68 (include_paths)
+
+/* Particular pre-defined modes.  */
+
+#define MODE(p)        A68 (a68_modes.p)
+#define M_BITS (MODE (BITS))
+#define M_BOOL (MODE (BOOL))
+#define M_BYTES (MODE (BYTES))
+#define M_CHANNEL (MODE (CHANNEL))
+#define M_CHAR (MODE (CHAR))
+#define M_COLLITEM (MODE (COLLITEM))
+#define M_COMPLEX (MODE (COMPLEX))
+#define M_C_STRING (MODE (C_STRING))
+#define M_ERROR (MODE (ERROR))
+#define M_FILE (MODE (FILE))
+#define M_FLEX_ROW_BOOL (MODE (FLEX_ROW_BOOL))
+#define M_FLEX_ROW_CHAR (MODE (FLEX_ROW_CHAR))
+#define M_FORMAT (MODE (FORMAT))
+#define M_HIP (MODE (HIP))
+#define M_INT (MODE (INT))
+#define M_LONG_BITS (MODE (LONG_BITS))
+#define M_LONG_BYTES (MODE (LONG_BYTES))
+#define M_LONG_COMPLEX (MODE (LONG_COMPLEX))
+#define M_LONG_INT (MODE (LONG_INT))
+#define M_LONG_LONG_INT (MODE (LONG_LONG_INT))
+#define M_LONG_LONG_BITS (MODE (LONG_LONG_BITS))
+#define M_LONG_LONG_COMPLEX (MODE (LONG_LONG_COMPLEX))
+#define M_LONG_LONG_INT (MODE (LONG_LONG_INT))
+#define M_LONG_LONG_REAL (MODE (LONG_LONG_REAL))
+#define M_LONG_REAL (MODE (LONG_REAL))
+#define M_NIL (MODE (NIL))
+#define M_NUMBER (MODE (NUMBER))
+#define M_PROC_LONG_REAL_LONG_REAL (MODE (PROC_LONG_REAL_LONG_REAL))
+#define M_PROC_REAL_REAL (MODE (PROC_REAL_REAL))
+#define M_PROC_REF_FILE_BOOL (MODE (PROC_REF_FILE_BOOL))
+#define M_PROC_REF_FILE_VOID (MODE (PROC_REF_FILE_VOID))
+#define M_PROC_ROW_CHAR (MODE (PROC_ROW_CHAR))
+#define M_PROC_STRING (MODE (PROC_STRING))
+#define M_PROC_VOID (MODE (PROC_VOID))
+#define M_REAL (MODE (REAL))
+#define M_REF_BITS (MODE (REF_BITS))
+#define M_REF_BOOL (MODE (REF_BOOL))
+#define M_REF_BYTES (MODE (REF_BYTES))
+#define M_REF_CHAR (MODE (REF_CHAR))
+#define M_REF_COMPLEX (MODE (REF_COMPLEX))
+#define M_REF_FILE (MODE (REF_FILE))
+#define M_REF_INT (MODE (REF_INT))
+#define M_REF_LONG_BITS (MODE (REF_LONG_BITS))
+#define M_REF_LONG_BYTES (MODE (REF_LONG_BYTES))
+#define M_REF_LONG_COMPLEX (MODE (REF_LONG_COMPLEX))
+#define M_REF_LONG_INT (MODE (REF_LONG_INT))
+#define M_REF_LONG_LONG_BITS (MODE (REF_LONG_LONG_BITS))
+#define M_REF_LONG_LONG_COMPLEX (MODE (REF_LONG_LONG_COMPLEX))
+#define M_REF_LONG_LONG_INT (MODE (REF_LONG_LONG_INT))
+#define M_REF_LONG_LONG_REAL (MODE (REF_LONG_LONG_REAL))
+#define M_REF_LONG_REAL (MODE (REF_LONG_REAL))
+#define M_REF_REAL (MODE (REF_REAL))
+#define M_REF_REF_FILE (MODE (REF_REF_FILE))
+#define M_REF_SHORT_BITS (MODE (REF_SHORT_BITS))
+#define M_REF_SHORT_SHORT_BITS (MODE (REF_SHORT_SHORT_BITS))
+#define M_REF_ROW_CHAR (MODE (REF_ROW_CHAR))
+#define M_REF_ROW_COMPLEX (MODE (REF_ROW_COMPLEX))
+#define M_REF_ROW_INT (MODE (REF_ROW_INT))
+#define M_REF_ROW_REAL (MODE (REF_ROW_REAL))
+#define M_REF_ROW_ROW_COMPLEX (MODE (REF_ROW_ROW_COMPLEX))
+#define M_REF_ROW_ROW_REAL (MODE (REF_ROW_ROW_REAL))
+#define M_REF_SHORT_INT (MODE (REF_SHORT_INT))
+#define M_REF_SHORT_SHORT_INT (MODE (REF_SHORT_SHORT_INT))
+#define M_REF_STRING (MODE (REF_STRING))
+#define M_ROW_BITS (MODE (ROW_BITS))
+#define M_ROW_BOOL (MODE (ROW_BOOL))
+#define M_ROW_CHAR (MODE (ROW_CHAR))
+#define M_ROW_COMPLEX (MODE (ROW_COMPLEX))
+#define M_ROW_INT (MODE (ROW_INT))
+#define M_ROW_REAL (MODE (ROW_REAL))
+#define M_ROW_ROW_CHAR (MODE (ROW_ROW_CHAR))
+#define M_ROW_ROW_COMPLEX (MODE (ROW_ROW_COMPLEX))
+#define M_ROW_ROW_REAL (MODE (ROW_ROW_REAL))
+#define M_ROW_SIMPLIN (MODE (ROW_SIMPLIN))
+#define M_ROW_SIMPLOUT (MODE (ROW_SIMPLOUT))
+#define M_ROWS (MODE (ROWS))
+#define M_ROW_STRING (MODE (ROW_STRING))
+#define M_SEMA (MODE (SEMA))
+#define M_SHORT_BITS (MODE (SHORT_BITS))
+#define M_SHORT_SHORT_BITS (MODE (SHORT_SHORT_BITS))
+#define M_SHORT_INT (MODE (SHORT_INT))
+#define M_SHORT_SHORT_INT (MODE (SHORT_SHORT_INT))
+#define M_SIMPLIN (MODE (SIMPLIN))
+#define M_SIMPLOUT (MODE (SIMPLOUT))
+#define M_STRING (MODE (STRING))
+#define M_UNDEFINED (MODE (UNDEFINED))
+#define M_VACUUM (MODE (VACUUM))
+#define M_VOID (MODE (VOID))
+
+/* Usage of TYPE_LANG_FLAG_* flags.  */
+
+#define A68_ROW_TYPE_P(NODE) TYPE_LANG_FLAG_0 (NODE)
+#define A68_UNION_TYPE_P(NODE) TYPE_LANG_FLAG_1 (NODE)
+#define A68_STRUCT_TYPE_P(NODE) TYPE_LANG_FLAG_2 (NODE)
+#define A68_ROWS_TYPE_P(NODE) TYPE_LANG_FLAG_3 (NODE)
+#define A68_TYPE_HAS_ROWS_P(NODE) TYPE_LANG_FLAG_4 (NODE)
+
+/* Language-specific tree checkers.  */
+
+#define STRUCT_OR_UNION_TYPE_CHECK(NODE) \
+  TREE_CHECK2 (NODE, RECORD_TYPE, UNION_TYPE)
+
+/* Usage of TYPE_LANG_SLOT_* fields.  */
+
+#define TYPE_FORWARD_REFERENCES(NODE) \
+  (TYPE_LANG_SLOT_1 (STRUCT_OR_UNION_TYPE_CHECK (NODE)))
+
+/* Parser global state.  */
+
+extern PARSER_T a68_parser_state;
+#define A68_PARSER(Z) (a68_parser_state.Z)
+
+/* a68-unistr.cc */
+
+int a68_u8_mbtouc (uint32_t *puc, const uint8_t *s, size_t n);
+int a68_u8_uctomb (uint8_t *s, uint32_t uc, ptrdiff_t n);
+
+uint32_t *a68_u8_to_u32 (const uint8_t *s, size_t n, uint32_t *resultbuf, size_t *lengthp);
+
+/* a68-lang.cc */
+
+enum a68_tree_index
+{
+  /* Type trees.  */
+  ATI_VOID_TYPE,
+  ATI_BOOL_TYPE,
+  ATI_CHAR_TYPE,
+  ATI_SHORT_SHORT_BITS_TYPE,
+  ATI_SHORT_BITS_TYPE,
+  ATI_BITS_TYPE,
+  ATI_LONG_BITS_TYPE,
+  ATI_LONG_LONG_BITS_TYPE,
+  ATI_BYTES_TYPE,
+  ATI_LONG_BYTES_TYPE,
+  ATI_SHORT_SHORT_INT_TYPE,
+  ATI_SHORT_INT_TYPE,
+  ATI_INT_TYPE,
+  ATI_LONG_INT_TYPE,
+  ATI_LONG_LONG_INT_TYPE,
+  ATI_REAL_TYPE,
+  ATI_LONG_REAL_TYPE,
+  ATI_LONG_LONG_REAL_TYPE,
+  /* Sentinel.  */
+  ATI_MAX
+};
+
+extern GTY(()) tree a68_global_trees[ATI_MAX];
+
+#define a68_void_type               a68_global_trees[ATI_VOID_TYPE]
+#define a68_bool_type               a68_global_trees[ATI_BOOL_TYPE]
+#define a68_char_type               a68_global_trees[ATI_CHAR_TYPE]
+#define a68_short_short_bits_type   a68_global_trees[ATI_SHORT_SHORT_BITS_TYPE]
+#define a68_short_bits_type         a68_global_trees[ATI_SHORT_BITS_TYPE]
+#define a68_bits_type               a68_global_trees[ATI_BITS_TYPE]
+#define a68_long_bits_type          a68_global_trees[ATI_LONG_BITS_TYPE]
+#define a68_long_long_bits_type     a68_global_trees[ATI_LONG_LONG_BITS_TYPE]
+#define a68_bytes_type              a68_global_trees[ATI_BYTES_TYPE]
+#define a68_long_bytes_type         a68_global_trees[ATI_LONG_BYTES_TYPE]
+#define a68_short_short_int_type    a68_global_trees[ATI_SHORT_SHORT_INT_TYPE]
+#define a68_short_int_type          a68_global_trees[ATI_SHORT_INT_TYPE]
+#define a68_int_type                a68_global_trees[ATI_INT_TYPE]
+#define a68_long_int_type           a68_global_trees[ATI_LONG_INT_TYPE]
+#define a68_long_long_int_type      a68_global_trees[ATI_LONG_LONG_INT_TYPE]
+#define a68_real_type               a68_global_trees[ATI_REAL_TYPE]
+#define a68_long_real_type          a68_global_trees[ATI_LONG_REAL_TYPE]
+#define a68_long_long_real_type     a68_global_trees[ATI_LONG_LONG_REAL_TYPE]
+
+struct lang_type *a68_build_lang_type (MOID_T *moid);
+struct lang_decl *a68_build_lang_decl (NODE_T *node);
+MOID_T *a68_type_moid (tree type);
+
+/* a68-diagnostics.cc  */
+
+void a68_error (NODE_T *p, const char *loc_str, ...);
+int a68_warning (NODE_T *p, int opt, const char *loc_str, ...);
+void a68_inform (NODE_T *p, const char *loc_str, ...);
+void a68_fatal (NODE_T *p, const char *loc_str, ...);
+void a68_scan_error (LINE_T *u, char *v, const char *txt, ...);
+
+/* a68-parser-scanner.cc  */
+
+bool a68_lexical_analyser (const char *filename);
+
+/* a68-parser.cc  */
+
+int a68_count_operands (NODE_T *p);
+int a68_count_formal_bounds (NODE_T *p);
+void a68_count_pictures (NODE_T *p, int *k);
+bool a68_is_ref_refety_flex (MOID_T *m);
+bool a68_is_semicolon_less (NODE_T *p);
+bool a68_is_formal_bounds (NODE_T *p);
+bool a68_is_unit_terminator (NODE_T *p);
+bool a68_is_loop_keyword (NODE_T *p);
+bool a68_is_new_lexical_level (NODE_T *p);
+bool a68_dont_mark_here (NODE_T *p);
+enum a68_attribute a68_get_good_attribute (NODE_T *p);
+void a68_parser (const char *filename);
+NODE_INFO_T *a68_new_node_info (void);
+GINFO_T *a68_new_genie_info (void);
+NODE_T *a68_new_node (void);
+NODE_T *a68_some_node (const char *t);
+TABLE_T *a68_new_symbol_table (TABLE_T *p);
+MOID_T *a68_new_moid (void);
+PACK_T *a68_new_pack (void);
+TAG_T *a68_new_tag (void);
+void a68_make_special_mode (MOID_T **, int m);
+void a68_make_sub (NODE_T *p, NODE_T *, enum a68_attribute t);
+bool a68_whether (NODE_T *, ...);
+bool a68_is_one_of (NODE_T *p, ...);
+void a68_bufcat (char *dst, const char *src, int len);
+void a68_bufcpy (char *dst, const char *src, int len);
+char *a68_new_string (const char *t, ...);
+const char *a68_attribute_name (enum a68_attribute attr);
+location_t a68_get_node_location (NODE_T *p);
+location_t a68_get_line_location (LINE_T *line, const char *pos);
+
+/* a68-parser-top-down.cc  */
+
+void a68_substitute_brackets (NODE_T *p);
+char *a68_phrase_to_text (NODE_T *p, NODE_T **w);
+void a68_top_down_parser (NODE_T *p);
+
+/* a68-parser-bottom-up.cc  */
+
+void a68_bottom_up_parser (NODE_T *p);
+void a68_bottom_up_error_check (NODE_T *p);
+void a68_rearrange_goto_less_jumps (NODE_T *p);
+
+/* a68-parser-extract.cc  */
+
+void a68_extract_indicants (NODE_T *p);
+void a68_extract_priorities (NODE_T *p);
+void a68_extract_operators (NODE_T *p);
+void a68_extract_labels (NODE_T *p, int expect);
+void a68_extract_declarations (NODE_T *p);
+void a68_elaborate_bold_tags (NODE_T *p);
+
+/* a68-parser-keywords.cc  */
+
+void a68_set_up_tables (void);
+TOKEN_T *a68_add_token (TOKEN_T **p, const char *t);
+KEYWORD_T *a68_find_keyword (KEYWORD_T *p, const char *t);
+KEYWORD_T *a68_find_keyword_from_attribute (KEYWORD_T *p, enum a68_attribute a);
+
+/* a68-postulates.cc  */
+
+void a68_init_postulates (void);
+void a68_free_postulate_list (POSTULATE_T *, POSTULATE_T *);
+void a68_make_postulate (POSTULATE_T **, MOID_T *, MOID_T *);
+POSTULATE_T *a68_is_postulated (POSTULATE_T *, MOID_T *);
+POSTULATE_T *a68_is_postulated_pair (POSTULATE_T *, MOID_T *, MOID_T *);
+
+/* a68-parser-moids-check.cc  */
+
+void a68_mode_checker (NODE_T *p);
+
+/* a68-parser-moids-coerce.cc */
+
+void a68_coercion_inserter (NODE_T *p);
+
+/* a68-parser-moids-equivalence.cc  */
+
+bool a68_prove_moid_equivalence (MOID_T *, MOID_T *);
+
+/* a68-parser-brackets.cc  */
+
+void a68_check_parenthesis (NODE_T *top);
+
+/* a68-parser-prelude.cc  */
+
+void a68_make_standard_environ (void);
+
+/* a68-parser-taxes.cc  */
+
+void a68_set_proc_level (NODE_T *p, int n);
+void a68_set_nest (NODE_T *p, NODE_T *s);
+int a68_first_tag_global (TABLE_T * table, const char *name);
+void a68_collect_taxes (NODE_T *p);
+TAG_T *a68_add_tag (TABLE_T *s, int a, NODE_T *n, MOID_T *m, int p);
+TAG_T *a68_find_tag_global (TABLE_T *table, int a, const char *name);
+int a68_is_identifier_or_label_global (TABLE_T *table, const char *name);
+void a68_reset_symbol_table_nest_count (NODE_T *p);
+void a68_bind_routine_tags_to_tree (NODE_T *p);
+void a68_fill_symbol_table_outer (NODE_T *p, TABLE_T *s);
+void a68_finalise_symbol_table_setup (NODE_T *p, int l);
+void a68_preliminary_symbol_table_setup (NODE_T *p);
+void a68_mark_moids (NODE_T *p);
+void a68_mark_auxilliary (NODE_T *p);
+void a68_warn_for_unused_tags (NODE_T *p);
+void a68_jumps_from_procs (NODE_T *p);
+
+/* a68-parser-victal.cc  */
+
+void a68_victal_checker (NODE_T *p);
+
+/* a68-parser-modes.cc  */
+
+int a68_count_pack_members (PACK_T *u);
+MOID_T *a68_register_extra_mode (MOID_T **z, MOID_T *u);
+MOID_T *a68_add_mode (MOID_T **z, int att, int dim, NODE_T *node, MOID_T *sub, PACK_T *pack);
+void a68_contract_union (MOID_T *u);
+PACK_T *a68_absorb_union_pack (PACK_T * u);
+void a68_add_mode_to_pack (PACK_T **p, MOID_T *m, const char *text, NODE_T *node);
+void a68_add_mode_to_pack_end (PACK_T **p, MOID_T *m, const char *text, NODE_T *node);
+void a68_make_moid_list (MODULE_T *mod);
+
+void a68_renumber_moids (MOID_T *p, int n);
+
+/* a68-moids-to-string.cc  */
+
+char *a68_moid_to_string (MOID_T *n, size_t w, NODE_T *idf,
+			  bool indicant_value = false);
+
+/* a68-moids-misc.cc  */
+
+bool a68_basic_coercions (MOID_T *p, MOID_T *q, int c, int deflex);
+bool a68_clause_allows_balancing (int att);
+bool a68_is_balanced (NODE_T *n, SOID_T *y, int sort);
+bool a68_is_coercible_in_context (SOID_T *p, SOID_T *q, int deflex);
+bool a68_is_coercible (MOID_T *p, MOID_T *q, int c, int deflex);
+bool a68_is_coercible_series (MOID_T *p, MOID_T *q, int c, int deflex);
+bool a68_is_coercible_stowed (MOID_T *p, MOID_T *q, int c, int deflex);
+bool a68_is_deprefable (MOID_T *p);
+bool a68_is_equal_modes (MOID_T *p, MOID_T *q, int deflex);
+bool a68_is_firmly_coercible (MOID_T *p, MOID_T *q, int deflex);
+bool a68_is_firm (MOID_T *p, MOID_T *q);
+bool a68_is_meekly_coercible (MOID_T *p, MOID_T *q, int deflex);
+bool a68_is_mode_isnt_well (MOID_T *p);
+bool a68_is_moid_in_pack (MOID_T *u, PACK_T *v, int deflex);
+bool a68_is_name_struct (MOID_T *p);
+bool a68_is_nonproc (MOID_T *p);
+bool a68_is_printable_mode (MOID_T *p);
+bool a68_is_proc_ref_file_void_or_format (MOID_T *p);
+bool a68_is_readable_mode (MOID_T *p);
+bool a68_is_ref_row (MOID_T *p);
+bool a68_is_rows_type (MOID_T *p);
+bool a68_is_softly_coercible (MOID_T *p, MOID_T *q, int deflex);
+bool a68_is_strongly_coercible (MOID_T *p, MOID_T *q, int deflex);
+bool a68_is_strong_name (MOID_T *p, MOID_T *q);
+bool a68_is_strong_slice (MOID_T *p, MOID_T *q);
+bool a68_is_subset (MOID_T *p, MOID_T *q, int deflex);
+bool a68_is_transput_mode (MOID_T *p, char rw);
+bool a68_is_unitable (MOID_T *p, MOID_T *q, int deflex);
+bool a68_is_weakly_coercible (MOID_T * p, MOID_T * q, int deflex);
+bool a68_is_widenable (MOID_T *p, MOID_T *q);
+MOID_T *a68_absorb_related_subsets (MOID_T *m);
+MOID_T *a68_depref_completely (MOID_T *p);
+MOID_T *a68_depref_once (MOID_T *p);
+MOID_T *a68_depref_rows (MOID_T *p, MOID_T *q);
+MOID_T *a68_deproc_completely (MOID_T *p);
+MOID_T *a68_derow (MOID_T *p);
+MOID_T *a68_determine_unique_mode (SOID_T *z, int deflex);
+MOID_T *a68_get_balanced_mode (MOID_T *m, int sort, bool return_depreffed, int deflex);
+MOID_T *a68_get_balanced_mode_or_no_mode (MOID_T *m, int sort, bool return_depreffed, int deflex);
+MOID_T *a68_make_series_from_moids (MOID_T *u, MOID_T *v);
+MOID_T *a68_make_united_mode (MOID_T *m);
+MOID_T *a68_pack_soids_in_moid (SOID_T *top_sl, int attribute);
+MOID_T *a68_unites_to (MOID_T *m, MOID_T *u);
+void a68_absorb_series_pack (MOID_T **p);
+void a68_absorb_series_union_pack (MOID_T **p);
+void a68_add_to_soid_list (SOID_T **root, NODE_T *where, SOID_T *soid);
+void a68_free_soid_list (SOID_T *root);
+void a68_investigate_firm_relations (PACK_T *u, PACK_T *v, bool *all, bool *some);
+void a68_make_coercion (NODE_T *l, enum a68_attribute a, MOID_T *m);
+void a68_make_depreffing_coercion (NODE_T *n, MOID_T *p, MOID_T *q);
+void a68_make_ref_rowing_coercion (NODE_T *n, MOID_T *p, MOID_T *q);
+void a68_make_rowing_coercion (NODE_T *n, MOID_T *p, MOID_T *q);
+void a68_make_soid (SOID_T *s, int sort, MOID_T *type, int attribute);
+void a68_make_strong (NODE_T *n, MOID_T *p, MOID_T *q);
+void a68_make_uniting_coercion (NODE_T *n, MOID_T *q);
+void a68_make_void (NODE_T *p, MOID_T *q);
+
+#define A68_DEPREF true
+#define A68_NO_DEPREF false
+
+#define A68_IF_MODE_IS_WELL(n) (! ((n) == M_ERROR || (n) == M_UNDEFINED))
+
+/* a68-parser-scope.cc  */
+
+void a68_scope_checker (NODE_T *p);
+
+/* a68-parser-serial-dsa.cc  */
+
+void a68_serial_dsa (NODE_T *p);
+
+/* a68-moids-diagnostics.cc  */
+
+char *a68_mode_error_text (NODE_T *n, MOID_T *p, MOID_T *q, int context, int deflex, int depth);
+void a68_cannot_coerce (NODE_T *p, MOID_T *from, MOID_T *to, int context, int deflex, int att);
+void a68_warn_for_voiding (NODE_T *p, SOID_T *x, SOID_T *y, int c);
+void a68_semantic_pitfall (NODE_T *p, MOID_T *m, int c, int u);
+
+/* a68-low-misc.cc  */
+
+tree a68_lower_assertion (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_jump (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_parameter (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_parameter_list (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_parameter_pack (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_operator (NODE_T *p, LOW_CTX_T ctx);
+
+/* a68-low-moids.cc  */
+
+void a68_lower_moids (MOID_T *m);
+void a68_set_type_moid (tree type, MOID_T *m);
+tree a68_row_elements_pointer_type (tree type);
+tree a68_row_elements_type (tree type);
+tree a68_triplet_type (void);
+
+/* a68-low-bits.cc */
+
+tree a68_get_bits_skip_tree (MOID_T *m);
+tree a68_bits_width (tree type);
+tree a68_bits_maxbits (tree type);
+tree a68_bits_bin (MOID_T *m, tree val);
+tree a68_bits_abs (MOID_T *m, tree bits);
+tree a68_bits_leng (tree type, tree bits);
+tree a68_bits_shorten (tree type, tree bits);
+tree a68_bits_not (tree bits);
+tree a68_bits_and (tree bits1, tree bits2);
+tree a68_bits_ior (tree bits1, tree bits2);
+tree a68_bits_xor (tree bits1, tree bits2);
+tree a68_bits_elem (NODE_T *p, tree pos, tree bits);
+tree a68_bits_subset (tree bits1, tree bits2);
+tree a68_bits_shift (tree shift, tree bits);
+tree a68_bits_eq (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_bits_ne (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+
+/* a68-low_bools.cc  */
+
+tree a68_get_bool_skip_tree (void);
+tree a68_bool_abs (tree val);
+tree a68_bool_eq (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_bool_ne (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+
+/* a68-low-ints.cc  */
+
+tree a68_get_int_skip_tree (MOID_T *m);
+tree a68_int_maxval (tree type);
+tree a68_int_minval (tree type);
+tree a68_int_width (tree type);
+tree a68_int_sign (tree val);
+tree a68_int_abs (tree val);
+tree a68_int_shorten (MOID_T *to_mode, MOID_T *from_mode, tree val);
+tree a68_int_leng (MOID_T *to_mode, MOID_T *from_mode, tree val);
+
+tree a68_int_plus (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_int_minus (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_int_mult (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_int_div (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_int_mod (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_int_pow (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_int_eq (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_int_ne (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_int_lt (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_int_le (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_int_gt (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_int_ge (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+
+/* a68-low-complex.cc  */
+
+tree a68_complex_i (MOID_T *mode, tree re, tree im);
+tree a68_complex_re (tree z);
+tree a68_complex_im (tree z);
+tree a68_complex_conj (MOID_T *mode, tree z);
+tree a68_complex_widen_from_real (MOID_T *mode, tree r);
+
+/* a68-low-posix.cc  */
+
+tree a68_posix_setexitstatus (void);
+tree a68_posix_argc (void);
+tree a68_posix_argv (void);
+tree a68_posix_getenv (void);
+tree a68_posix_putchar (void);
+tree a68_posix_puts (void);
+tree a68_posix_fconnect (void);
+tree a68_posix_fcreate (void);
+tree a68_posix_fopen (void);
+tree a68_posix_fclose (void);
+tree a68_posix_fsize (void);
+tree a68_posix_errno (void);
+tree a68_posix_perror (void);
+tree a68_posix_strerror (void);
+tree a68_posix_getchar (void);
+tree a68_posix_fgetc (void);
+tree a68_posix_fputc (void);
+tree a68_posix_fputs (void);
+tree a68_posix_gets (void);
+tree a68_posix_fgets (void);
+
+/* a68-low-reals.cc  */
+
+tree a68_get_real_skip_tree (MOID_T *m);
+tree a68_real_pi (tree type);
+tree a68_real_maxval (tree type);
+tree a68_real_minval (tree type);
+tree a68_real_smallval (tree type);
+tree a68_real_width (tree type);
+tree a68_real_exp_width (tree type);
+tree a68_real_sign (tree val);
+tree a68_real_abs (tree val);
+tree a68_real_sqrt (tree val);
+tree a68_real_tan (tree type);
+tree a68_real_sin (tree type);
+tree a68_real_cos (tree type);
+tree a68_real_acos (tree type);
+tree a68_real_asin (tree type);
+tree a68_real_atan (tree type);
+tree a68_real_ln (tree type);
+tree a68_real_log (tree type);
+tree a68_real_exp (tree type);
+tree a68_real_shorten (MOID_T *to_mode, MOID_T *from_mode, tree val);
+tree a68_real_leng (MOID_T *to_mode, MOID_T *from_mode, tree val);
+tree a68_real_entier (tree val, MOID_T *to_mode, MOID_T *from_mode);
+tree a68_real_round (tree val, MOID_T *to_mode, MOID_T *from_mode);
+
+tree a68_real_plus (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_real_minus (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_real_mult (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_real_div (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_real_mod (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_real_pow (MOID_T *m, MOID_T *a_mode, MOID_T *b_mode,
+		   tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_real_eq (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_real_ne (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_real_lt (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_real_le (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_real_gt (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_real_ge (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+
+
+/* a68-low-strings.cc  */
+
+tree a68_get_string_skip_tree (void);
+tree a68_string_concat (tree str1, tree str2);
+tree a68_string_mult (tree str1, tree str2);
+tree a68_string_from_char (tree c);
+tree a68_string_cmp (tree s1, tree s2);
+char *a68_string_process_breaks (const char *str);
+
+/* a68-low-chars.cc */
+
+tree a68_get_char_skip_tree (void);
+tree a68_char_max (void);
+tree a68_char_repr (NODE_T *p, tree val);
+tree a68_char_abs (tree val);
+tree a68_char_eq (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_char_ne (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_char_lt (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_char_le (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_char_gt (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+tree a68_char_ge (tree a, tree b, location_t loc = UNKNOWN_LOCATION);
+
+/* a68-low-refs.cc  */
+
+tree a68_get_ref_skip_tree (MOID_T *m);
+
+/* a68-low-procs.cc  */
+
+tree a68_get_proc_skip_tree (MOID_T *m);
+
+/* a68-low-structs.cc  */
+
+tree a68_get_struct_skip_tree (MOID_T *m);
+
+/* a68-low-multiples.cc  */
+
+tree a68_get_multiple_skip_tree (MOID_T *m);
+tree a68_multiple_dimensions (tree exp);
+tree a68_multiple_num_elems (tree exp);
+tree a68_multiple_lower_bound (tree exp, tree dim);
+tree a68_multiple_upper_bound (tree exp, tree dim);
+tree a68_multiple_stride (tree exp, tree dim);
+tree a68_multiple_triplets (tree exp);
+tree a68_multiple_elements (tree exp);
+tree a68_multiple_elements_size (tree exp);
+tree a68_multiple_set_elements (tree exp, tree elements);
+tree a68_multiple_set_elements_size (tree exp, tree elements_size);
+void a68_multiple_compute_strides (tree type, size_t dim,
+				   tree *lower_bounds, tree *upper_bounds,
+				   tree *strides);
+tree a68_multiple_set_lower_bound (tree exp, tree dim, tree bound);
+tree a68_multiple_set_upper_bound (tree exp, tree dim, tree bound);
+tree a68_multiple_set_stride (tree exp, tree dim, tree stride);
+tree a68_row_value (tree type, size_t dim,
+		    tree elements, tree elements_size,
+		    tree *lower_bound, tree *upper_bound);
+tree a68_row_value_raw (tree type, tree descriptor,
+			tree elements, tree elements_size);
+tree a68_row_malloc (tree type, int dim,
+		    tree elements, tree elements_size,
+		    tree *lower_bound, tree *upper_bound);		     
+tree a68_multiple_slice (NODE_T *p, tree multiple, bool slicing_name,
+			 int num_indexes, tree *indexes);
+tree a68_multiple_copy_elems (MOID_T *to_mode, tree to, tree from);
+tree a68_rows_dim (tree exp);
+tree a68_rows_value (tree multiple);
+tree a68_rows_lower_bound (tree rows, tree dim);
+tree a68_rows_upper_bound (tree rows, tree dim);
+tree a68_rows_dim_check (NODE_T *p, tree rows, tree dim);
+tree a68_multiple_dim_check (NODE_T *p, tree multiple, tree dim);
+tree a68_multiple_single_bound_check (NODE_T *p, tree dim, tree multiple,
+				      tree index, bool upper_bound);
+tree a68_multiple_bounds_check (NODE_T *p, tree dim, tree multiple,
+				tree index);
+tree a68_multiple_bounds_check_equal (NODE_T *p, tree m1, tree m2);
+
+/* a68-low-ranges.cc  */
+
+bool a68_in_global_range (void);
+void a68_init_ranges (void);
+void a68_push_range (MOID_T *mode);
+tree a68_pop_range (void);
+tree a68_pop_range_with_finalizer (tree *finalizer);
+void a68_push_stmt_list (MOID_T *mode);
+tree a68_pop_stmt_list (void);
+void a68_push_function_range (tree fndel, tree result_type,
+			      bool top_level = false);
+void a68_pop_function_range (tree body);
+void a68_push_serial_clause_range (MOID_T *clause_mode,
+				   bool save_restore_stack = false);
+tree a68_pop_serial_clause_range (void);
+void a68_add_stmt (tree exp);
+void a68_add_decl (tree decl);
+void a68_add_decl_expr (tree decl_expr);
+void a68_add_completer (void);
+tree a68_range_context (void);
+tree a68_range_names (void);
+tree a68_range_stmt_list (void);
+
+/* a68-low-runtime.cc */
+
+enum a68_libcall_fn
+{
+#define DEF_A68_RUNTIME(CODE, N, T, P, F) A68_LIBCALL_ ## CODE,
+#include "a68-low-runtime.def"
+#undef DEF_A68_RUNTIME
+  A68_LIBCALL_LAST
+};
+
+tree a68_get_libcall (a68_libcall_fn libcall);
+tree a68_build_libcall (a68_libcall_fn libcall, tree type, int nargs, ...);
+
+/* a68-low-clauses.cc  */
+
+void a68_begin_serial_clause (LOW_CTX_T *ctx, MOID_T *clause_mode);
+tree a68_finish_serial_clause (LOW_CTX_T ctx, MOID_T *clause_mode, tree parent_block);
+tree a68_lower_label (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_labeled_unit (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_completer (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_initialiser_series (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_serial_clause (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_loop_clause (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_conformity_clause (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_case_clause (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_enquiry_clause (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_conditional_clause (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_unit_list (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_collateral_clause (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_parallel_clause (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_closed_clause (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_enclosed_clause (NODE_T *p, LOW_CTX_T ctx);
+
+/* a68-low-coercions.cc */
+
+tree a68_lower_dereferencing (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_rowing (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_widening (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_deproceduring (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_proceduring (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_voiding (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_uniting (NODE_T *p, LOW_CTX_T ctx);
+
+/* a68-low-decls.cc */
+
+tree a68_lower_mode_declaration (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_variable_declaration (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_identity_declaration (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_procedure_declaration (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_procedure_variable_declaration (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_declarer (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_declaration_list (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_priority_declaration (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_brief_operator_declaration (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_operator_declaration (NODE_T *p, LOW_CTX_T ctx);
+
+/* a68-low.cc  */
+
+tree a68_lower_top_tree (NODE_T *p);
+tree a68_lower_tree (NODE_T *p, LOW_CTX_T ctx);
+tree a68_make_identity_declaration_decl (NODE_T *identifier);
+tree a68_make_variable_declaration_decl (NODE_T *identifier);
+tree a68_make_proc_identity_declaration_decl (NODE_T *identifier);
+tree a68_make_anonymous_routine_decl (MOID_T *mode);
+tree a68_get_skip_tree (MOID_T *m);
+tree a68_get_empty (void);
+void a68_ref_counts (tree exp, MOID_T *m, int *num_refs, int *num_pointers);
+tree a68_consolidate_ref (MOID_T *m, tree expr);
+tree a68_lower_alloca (tree type, tree size);
+tree a68_lower_malloc (tree type, tree size);
+tree a68_checked_indirect_ref (NODE_T *p, tree exp, MOID_T *exp_mode);
+tree a68_low_deref (tree exp, NODE_T *p);
+tree a68_low_dup (tree exp, bool use_heap = false);
+tree a68_low_ascription (MOID_T *mode, tree lhs, tree rhs);
+tree a68_low_assignation (NODE_T *p, tree lhs, MOID_T *lhs_mode, tree rhs, MOID_T *rhs_mode);
+tree a68_lower_memcpy (tree dst, tree src, tree size);
+tree a68_lower_tmpvar (const char *name, tree type, tree init);
+tree a68_get_mangled_identifier (const char *name);
+tree a68_low_toplevel_func_decl (const char *name, tree fntype);
+tree a68_low_func_param (tree fndecl, const char *name, tree type);
+
+/* a68-low-builtins.cc */
+
+void a68_install_builtins ();
+
+/* a68-low-unions.c  */
+
+int a68_united_mode_index (MOID_T *p, MOID_T *q);
+tree a68_get_union_skip_tree (MOID_T *m);
+tree a68_union_overhead (tree exp);
+tree a68_union_set_overhead (tree exp, tree overhead);
+tree a68_union_cunion (tree exp);
+tree a68_union_alternative (tree exp, int index);
+tree a68_union_value (MOID_T *mode, tree exp, MOID_T *exp_mode);
+tree a68_union_translate_overhead (MOID_T *from, tree from_overhead, MOID_T *to);
+bool a68_union_contains_mode (MOID_T *p, MOID_T *q);
+
+/* a68-low-units.cc  */
+
+tree a68_lower_identifier (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_denotation (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_string_denotation (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_skip (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_nihil (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_empty (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_identity_relation (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_logic_function (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_primary (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_cast (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_secondary (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_slice (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_selection (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_formula (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_monadic_formula (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_tertiary (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_assignation (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_routine_text (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_generator (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_call (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_unit (NODE_T *p, LOW_CTX_T ctx);
+
+/* a68-low-generator.c  */
+
+tree a68_low_generator (NODE_T *declarer, MOID_T *mode,
+			bool heap, LOW_CTX_T ctx);
+tree a68_low_gen (MOID_T *m, size_t nbuonds, tree *bounds,
+		  bool use_heap);
+
+/* a68-low-prelude.c  */
+
+tree a68_lower_unimplemented (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_assert (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_intabs2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_realabs2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_boolabs2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_charabs2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_not2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_and3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_or3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_xor3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_confirm2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_negate2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_sign2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_realsign2 (NODE_T *p, LOW_CTX_T ctx);
+
+tree a68_lower_plus_int (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_plus_real (NODE_T *p, LOW_CTX_T ctx);
+
+tree a68_lower_minus_int (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_minus_real (NODE_T *p, LOW_CTX_T ctx);
+
+tree a68_lower_mult_int (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_mult_real (NODE_T *p, LOW_CTX_T ctx);
+
+tree a68_lower_multab3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_div3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_divab3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_rdiv3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_over3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_mod3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_int_eq3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_int_ne3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_int_lt3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_int_le3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_int_gt3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_int_ge3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_real_eq3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_real_ne3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_real_lt3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_real_le3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_real_gt3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_real_ge3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_char_eq3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_char_ne3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_char_lt3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_char_le3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_char_gt3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_char_ge3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bool_eq3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bool_ne3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_plusab3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_minusab3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_overab3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_modab3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_upb2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_upb3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_lwb2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_lwb3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_elems2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_elems3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_entier2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_round2 (NODE_T *p, LOW_CTX_T ctx);
+
+tree a68_lower_pow_int (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_pow_real (NODE_T *p, LOW_CTX_T ctx);
+
+tree a68_lower_odd2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_string_eq3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_string_ne3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_string_lt3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_string_le3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_string_gt3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_string_ge3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_string_plus3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_char_plus3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_string_plusab3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_string_mult3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_char_mult3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_string_multab3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_string_plusto3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_repr2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bitelem3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bin2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bitabs2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bitleng2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bitshorten2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bit_eq3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bit_ne3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bitnot2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bitand3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bitior3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bitxor3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_shl3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_shr3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bit_eq3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bit_ne3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bit_le3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bit_ge3 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_maxint (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_minint (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_maxbits (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_maxreal (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_minreal (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_smallreal (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bitswidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longbitswidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longlongbitswidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_shortbitswidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_shortshortbitswidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_intwidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longintwidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longlongintwidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_shortintwidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_shortshortintwidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_realwidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longrealwidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longlongrealwidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_expwidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longexpwidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longlongexpwidth (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_pi (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_nullcharacter (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_flip (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_flop (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_errorchar (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_blank (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_invalidchar (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_intlengths (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_intshorths (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bitslengths (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_bitsshorths (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_reallengths (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_realshorths (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_infinity (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_minusinfinity (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_maxabschar (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_sqrt (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_sqrt (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_long_sqrt (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_tan (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_tan (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_long_tan (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_sin (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_sin (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_long_sin (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_cos (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_cos (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_long_cos (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_acos (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_acos (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_long_acos (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_asin (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_asin (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_long_asin (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_atan (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_atan (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_long_atan (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_ln (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_ln (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_long_ln (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_log (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_log (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_long_log (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_exp (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_exp (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_long_long_exp (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_reali (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longreali (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longlongreali (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_inti (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longinti (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longlonginti (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_re2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_im2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_conj2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_shortenint2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_lengint2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_lengreal2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_shortenreal2 (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_random (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longrandom (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_longlongrandom (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_setexitstatus (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixargc (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixargv (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixputchar (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixputs (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfputc (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfputs (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixgetenv (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfconnect (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfopen (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfcreate (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfclose (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfsize (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixstdinfiledes (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixstdoutfiledes (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixstderrfiledes (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfileodefault (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfileordwr (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfileordonly (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfileowronly (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfileotrunc (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixerrno (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixperror (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixstrerror (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixgetchar (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfgetc (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixgets (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_posixfgets (NODE_T *p, LOW_CTX_T ctx);
+
+/* a68-parser-debug.cc  */
+
+void a68_dump_parse_tree (NODE_T *p);
+void a68_dump_modes (MOID_T *m);
+
+#endif /* ! __A68_H__ */
--- /dev/null
+++ b/src/gcc/algol68/a68spec.cc
@@ -0,0 +1,222 @@
+/* a68spec.c -- Specific flags and argument handling of the Algol 68 front end.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "opt-suggestions.h"
+#include "gcc.h"
+#include "tm.h"
+#include "opts.h"
+
+/* satisfy intellisense  */
+#include "options.h"
+
+/* How to link with libga68.  */
+enum libga68_link_mode
+{
+  LIBGA68_NOLINK,
+  LIBGA68_STATIC,
+  LIBGA68_DYNAMIC
+};
+
+static enum libga68_link_mode libga68_link = LIBGA68_STATIC;
+
+/* This bit is set if we saw a `-xfoo' language specification.  */
+#define LANGSPEC (1 << 1)
+/* This bit is set if they did `-lc'.  */
+#define WITHLIBC (1 << 2)
+/* Skip this option.  */
+#define SKIPOPT (1 << 3)
+
+void
+lang_specific_driver (struct cl_decoded_option **in_decoded_options,
+		      unsigned int *in_decoded_options_count,
+		      int *in_added_libraries)
+{
+  unsigned int i, j;
+
+  /* The new argument list will be contained in this.  */
+  struct cl_decoded_option *new_decoded_options;
+
+  /* "-lc" if it appears on the command line.  */
+  const struct cl_decoded_option *saw_libc = 0;
+
+  /* An array used to flag each argument that needs a bit set for
+     LANGSPEC or WITHLIBC.  */
+  int *args;
+
+  /* True if we saw -static.  */
+  int static_link = 0;
+
+  /* True if we should add -shared-libgcc to the command-line.  */
+  int shared_libgcc = 1;
+
+  /* The total number of arguments with the new stuff.  */
+  unsigned int argc;
+
+  /* The argument list.  */
+  struct cl_decoded_option *decoded_options;
+
+  /* The number of libraries added in.  */
+  int added_libraries;
+
+  /* The total number of arguments with the new stuff.  */
+  int num_args = 1;
+
+  /* Whether the -o option was used.  */
+  //  bool saw_opt_o = false;
+
+  argc = *in_decoded_options_count;
+  decoded_options = *in_decoded_options;
+  added_libraries = *in_added_libraries;
+
+  args = XCNEWVEC (int, argc);
+
+  for (i = 1; i < argc; i++)
+    {
+      const char *arg = decoded_options[i].arg;
+
+      switch (decoded_options[i].opt_index)
+	{
+	case OPT__help:
+	case OPT__help_:
+	  /* Let gcc.cc handle this.  */
+	  *in_added_libraries = 0;
+	  return;
+	case OPT_c:
+	case OPT_E:
+	case OPT_M:
+	case OPT_MM:
+	case OPT_fsyntax_only:
+	case OPT_S:
+	  libga68_link = LIBGA68_NOLINK;
+	  break;
+
+	case OPT_l:
+	  if (strcmp (arg, "c") == 0)
+	    args[i] |= WITHLIBC;
+	  break;
+
+	case OPT_o:
+	  //saw_opt_o = true;
+	  break;
+
+	case OPT_static:
+	  static_link = 1;
+	  break;
+
+	case OPT_static_libgcc:
+	  shared_libgcc = 0;
+	  break;
+
+	case OPT_static_libga68:
+	  libga68_link = LIBGA68_STATIC;
+#ifdef HAVE_LD_STATIC_DYNAMIC
+	  /* Remove -static-libga68 from the command only if target supports
+	     LD_STATIC_DYNAMIC.  When not supported, it is left in so that a
+	     back-end target can use outfile substitution.  */
+	  args[i] |= SKIPOPT;
+#endif
+	  break;
+
+	case OPT_shared_libga68:
+	  libga68_link = LIBGA68_DYNAMIC;
+	  args[i] |= SKIPOPT;
+	  break;
+
+	case OPT_SPECIAL_input_file:
+	  break;
+	}
+    }
+
+    /* There's no point adding -shared-libgcc if we don't have a shared
+       libgcc.  */
+#ifndef ENABLE_SHARED_LIBGCC
+  shared_libgcc = 0;
+#endif
+
+  /* Make sure to have room for the trailing NULL argument.
+     - libga68 adds `-Bstatic -lga68 -Bdynamic' */
+  num_args = argc + shared_libgcc + 1 * 5 + 10;
+  new_decoded_options = XNEWVEC (struct cl_decoded_option, num_args);
+
+  i = 0;
+  j = 0;
+
+  /* Copy the 0th argument, i.e., the name of the program itself.  */
+  new_decoded_options[j++] = decoded_options[i++];
+
+  /* NOTE: We start at 1 now, not 0.  */
+  while (i < argc)
+    {
+      new_decoded_options[j] = decoded_options[i];
+
+      if (!saw_libc && (args[i] & WITHLIBC))
+	{
+	  --j;
+	  saw_libc = &decoded_options[i];
+	}
+
+      if ((args[i] & SKIPOPT) != 0)
+	--j;
+
+      i++;
+      j++;
+    }
+
+  if (saw_libc)
+    new_decoded_options[j++] = *saw_libc;
+  if (shared_libgcc && !static_link)
+    generate_option (OPT_shared_libgcc, NULL, 1, CL_DRIVER,
+		     &new_decoded_options[j++]);
+
+  /* Add `-lga68 -lm' if we haven't already done so.  */
+#ifdef HAVE_LD_STATIC_DYNAMIC
+  if (libga68_link == LIBGA68_STATIC && !static_link)
+    {
+      generate_option (OPT_Wl_, LD_STATIC_OPTION, 1, CL_DRIVER,
+		       &new_decoded_options[j++]);
+      added_libraries++; /* The driver calls add_infile while handling -Wl */
+    }
+#endif
+  generate_option (OPT_l,
+		   "ga68", 1,
+		   CL_DRIVER, &new_decoded_options[j++]);
+  added_libraries++;
+#ifdef HAVE_LD_STATIC_DYNAMIC
+  if (libga68_link == LIBGA68_STATIC && !static_link)
+    {
+      generate_option (OPT_Wl_, LD_DYNAMIC_OPTION, 1, CL_DRIVER,
+		       &new_decoded_options[j++]);
+      added_libraries++; /* The driver calls add_infile while handling -Wl */
+    }
+#endif
+  *in_decoded_options_count = j;
+  *in_decoded_options = 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)
+{
+  if (libga68_link != LIBGA68_NOLINK)
+    do_spec ("%:include(libga68.spec)");
+  return 0;
+}
+
+/* Number of extra output files that lang_specific_pre_link may generate.  */
+int lang_specific_extra_outfiles = 0; /* Not used for Algol68.  */
--- /dev/null
+++ b/src/gcc/algol68/algol68-target.def
@@ -0,0 +1,52 @@
+/* Target hook definitions for the Algol68 front end.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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, 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/>.  */
+
+/* See target-hooks-macros.h for details of macros that should be
+   provided by the including file, and how to use them here.  */
+
+#include "target-hooks-macros.h"
+
+#undef HOOK_TYPE
+#define HOOK_TYPE "Algol68 Target Hook"
+
+HOOK_VECTOR (TARGETALGOL68M_INITIALIZER, gcc_targetalgol68m)
+
+#undef HOOK_PREFIX
+#define HOOK_PREFIX "TARGET_"
+
+/* Environmental CPU info and features (e.g. endianness, pointer size) relating
+   to the target CPU.  */
+DEFHOOK
+(algol68_cpu_info,
+ "Declare all environmental CPU info and features relating to the target CPU\n\
+using the function @code{algol68_add_target_info}, which takes a string\n\
+representing the feature key and a string representing the feature value.\n\
+Configuration pairs predefined by this hook apply to all files that are being\n\
+compiled.",
+ void, (void),
+ hook_void_void)
+
+/* Environmental OS info relating to the target OS.  */
+DEFHOOK
+(algol68_os_info,
+ "Similar to @code{TARGET_ALGOL68_CPU_INFO}, but is used for configuration info\n\
+relating to the target operating system.",
+ void, (void),
+ hook_void_void)
+
+/* Close the 'struct gcc_targetalgol68m' definition.  */
+HOOK_VECTOR_END (C90_EMPTY_HACK)
--- /dev/null
+++ b/src/gcc/algol68/config-lang.in
@@ -0,0 +1,29 @@
+# config-lang.in -- Top level configure fragment for gcc Algol 68 frontend.
+
+# Copyright (C) 2025 Free Software Foundation, Inc.
+
+# 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)
+
+language="algol68"
+compilers="a681\$(exeext)"
+gtfiles="\$(srcdir)/algol68/a68-lang.cc"
+
+target_libs="target-libga68"
--- /dev/null
+++ b/src/gcc/algol68/ga68-internals.texi
@@ -0,0 +1,383 @@
+\input texinfo  @c -*-texinfo-*-
+@c %**start of header
+@setfilename ga68-internals.info
+
+@include gcc-common.texi
+
+@synindex tp cp
+
+@settitle GNU Algol 68 Compiler Internals
+
+@c %**end of header
+
+@c %** start of document
+
+@copying
+Copyright @copyright{} 2025 Jose E. Marchesi.
+
+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 section entitled ``GNU Free
+Documentation License''.
+@end copying
+
+@ifinfo
+@dircategory Software development
+@direntry
+* ga68-internals: (ga68-internals).           The GNU Algol 68 Compiler Internals.
+@end direntry
+This file documents the internals of the GNU Algol 68
+compiler, (@command{ga68}).
+
+@insertcopying
+@end ifinfo
+
+@c Macro for bold-tags.  In TeX and HTML they expand to proper bold words,
+@c in other formats it resorts to upper stropping.
+@iftex
+@macro B{tag}
+@strong{\tag\}
+@end macro
+@end iftex
+
+@ifhtml
+@macro B{tag}
+@strong{\tag\}
+@end macro
+@end ifhtml
+
+@ifnottex
+@ifnothtml
+@macro B{tag}
+@sc{\tag\}
+@end macro
+@end ifnothtml
+@end ifnottex
+
+@setchapternewpage odd
+@titlepage
+@title GNU Algol 68 Internals
+@versionsubtitle
+@author Jose E. Marchesi
+@page
+@vskip 0pt plus 1filll
+@sp 1
+@insertcopying
+@end titlepage
+
+@summarycontents
+@contents
+
+@page
+
+@ifnottex
+@node Top
+@top Introduction
+@cindex Introduction
+
+This manual documents (some of) the internals of @command{ga68}, the
+GNU Algol 68 compiler.
+
+@menu
+* Scope Checking::         Scope checking in assignation.
+* Storage Management::     Management of run-time storage.
+* Lowering Declarations::  Mapping external objects to internal objects.
+* Lowering Assignations::  Superceding the value referred by a name.
+* GNU Free Documentation License::
+                           How you can copy and share this manual.
+* Index::                  Index of this documentation.
+@end menu
+@end ifnottex
+
+@c ---------------------------------------------------------------------
+@c Scope Checking
+@c ---------------------------------------------------------------------
+
+@node Scope Checking
+@chapter Scope Checking
+
+Static scope checking: pass.
+Dynamic scope checking: run-time call.
+
+@c ---------------------------------------------------------------------
+@c Storage Management
+@c ---------------------------------------------------------------------
+
+@node Storage Management
+@chapter Storage Management
+
+This chapter discusses the run-time management of internal objects in
+Algol 68.
+
+First, a conceptual model is presented that describes the restrictions
+as mandated by the Report.  The storage implied by the lowered GENERIC
+entities, as described in the previous chapter, shall match the
+storage of the conceptual model.
+
+@menu
+* Storage Structure of Objects::
+* Copying of Objects::
+* The Stack::
+* The Heap::
+@end menu
+
+@node Storage Structure of Objects
+@section Storage Structure of Objects
+
+The internal objects which are the values in an Algol 68 program may
+consist on a hierarchy of memory locations, which may not be
+contiguous.  This hierarchy of memory locations is the storage
+structure of the object, and is not concerned by the particular
+bit-patterns stored.
+
+Simple values.
+
+Names.
+
+Multiple values.
+
+Structured values.
+
+Values of united modes.
+
+@node Copying of Objects
+@section Copying of Objects
+
+@node The Stack
+@section The Stack
+
+XXX
+
+@node The Heap
+@section The Heap
+
+@itemize @minus
+@item
+A value that has rows and gets returned by a procedure shall be
+allocated on the stack.
+@item
+A copy of the right hand side is made before assigning it to the left
+hand side.  This copy is always allocated in the heap, because the
+scope of the left hand side may be older than the scope of the right
+hand side.  This happens when assigning to a global variable.
+@item
+A trimmer of a name.  This is because the trimmed multiple may be
+allocated on the heap, and the trim shall have the same scope than the
+trimmed multiple.
+@end itemize
+
+@c ---------------------------------------------------------------------
+@c Internal Objects
+@c ---------------------------------------------------------------------
+
+@node Lowering Declarations
+@chapter Lowering Declarations
+
+This chapter describes the mapping between external objects declared
+in identity and variable declarations and the internal objects that
+are the result of lowering the external objects in the parse tree into
+GENERIC entities.
+
+@menu
+* Identity Declarations::             @code{@B{amode} xxx = init value}
+* Variable Declarations::             @code{@B{amode} xxx [:= init value]}
+* Procedure Identity Declarations::   @code{@B{proc} xxx = routine text}
+* Procedure Variable Declarations::   @code{@B{proc} xxx := routine text}
+* Operator Brief Declarations::       @code{@B{op} @B{xxx} = routine text}
+* Operator Declarations::             @code{@B{op}(...)@B{amode} @B{xxx} = routine text}
+* Applied Identifiers::
+@end menu
+
+@node Identity Declarations
+@section Identity Declarations
+
+An identity declaration with the form:
+
+@example
+@B{c} part 1 @B{c}
+@B{amode} defining_identifier = unit;
+@B{c} part 2 @B{c}
+@end example
+
+@noindent
+Introduces the identifier @code{defining_identifier} in the current
+range and ascribes a copy of the value yielded by @code{unit} to it.
+Once established, the relationship between an identifier and the value
+ascribed to it is constant and it cannot change during the reach of
+the identifier.  The ascribed unit can be any unitary clause, and its
+elaboration can be arbitrarily complicated.  In particular, it is not
+required to be a compile-time constant.  @code{@B{amode}} determines
+the mode of the value yielded by the unit, and the unit is elaborated
+in a strong context.
+
+An identity declaration like the above, where @code{@B{amode}} is not
+a procedure mode (@xref{Procedure Identity Declarations}) is lowered
+into:
+
+@itemize @bullet
+@item
+A @code{VAR_DECL} with name @code{defining_identifier}, type
+@code{CTYPE (@B{amode})} and initial value @code{@B{amode}(@B{skip})}
+that gets chained into the declarations list of the current block.
+@item
+A @code{DECL_EXPR} that gets prepended in the current statement's list.
+@item
+A @code{MODIFY_EXPR} setting the @code{VAR_DECL} to a copy of the
+lowering of @code{unit}, @code{a68_low_dup (unit)}.
+@end itemize
+
+@noindent
+Schematically:
+
+@example
+   BIND_EXPR (BLOCK (DECLS: ... -> VAR_DECL (defining_identifier, INITIAL=SKIP)))
+     STMT_LIST
+     |
+     +-- DECL_EXPR (defining_identifier)
+     |
+     |   @B{c} part 1 @B{c}
+     |
+     +-- MODIFY_EXPR (defining_identifier, unit)
+     |
+     |   @B{c} part 2 @B{c}
+     |
+@end example
+
+The reason why the @code{VAR_DECL} is initialized to @code{@B{skip}}
+and then set to the initial @code{unit} specified in the source line
+is that the Report specifies that Algol 68 identifiers can be used
+before they are defined provided we are in the right range, but in
+that case the value ascribed to the identifier is ``undefined''.
+Accessing an ``undefined'' value in traditional Algol 68
+implementations would lead to a run-time error (these implementations
+used a special value to denote undefined, such as @code{F00L}) but in
+GNU Algol 68 the ``undefined'' value is always @code{@B{skip}} which,
+if not terribly useful in most cases, is at least well defined in this
+implementation and doesn't lead to an error.
+
+Identity declarations are the Algol 68 way of defining constants, and
+one may wonder why we are not using @code{CONST_DECL} instead of
+@code{VAR_DECL}.  The reason is that @code{CONST_DECL} is really only
+intended for integral values in C enums, and the @code{@B{amode}} in
+the identity declaration can really be any mode, from simple integers
+or characters to fairly complicated structured modes, which may
+involve also rows and united modes.  Whether the @code{VAR_DECL} will
+lead to allocating storage on the stack depends on the nature of the
+mode and the way the identifier is used in the program: whether its
+address is taken, etc.
+
+@node Variable Declarations
+@section Variable Declarations
+
+A variable declaration with the form:
+
+@example
+[@B{loc}|@B{heap}] @B{amode} defining identifier [:= unit];
+@end example
+
+@noindent
+Is in principle equivalent to the identity declaration:
+
+@example
+@B{ref} @B{amode} defining identifier = [@B{loc}|@B{heap}] @B{amode};
+@end example
+
+@noindent
+In both cases the object ascribed to the defining identifier is of
+mode @code{@B{ref} @B{amode}}.  The ascribed object is a name which is
+created by a generator implied in the actual declarer in the variable
+declaration case, and an explicit generator in the initialization
+expression in the identity declaration case.
+
+However, in this compiler these two cases are handled differently in
+order to reduce the amount of both indirect addressing and of storage:
+
+@itemize @bullet
+@item
+The variable declaration @code{[@B{loc}|@B{heap}] @B{amode} foo}
+lowers into a @code{VAR_DECL} with type @code{CTYPE (amode)} provided
+that the generator is @code{@B{loc}} and that the type contains no
+rows.  Accessing the variable will then involve direct addressing, and
+when its address is required an @code{ADDR_EXPR} shall be used.
+@item
+The identity declaration @code{@B{ref} @B{amode} foo = @B{loc}
+@B{amode}} lowers into a @code{VAR_DECL} with type @code{*CTYPE
+(amode)}.  Accessing the variable will then involve indirect
+addressing: it is effectively a pointer.
+@end itemize
+
+This optimization introduces the complication that an expression (the
+@code{VAR_DECL}) whose type is TYPE can appear in a place where *TYPE
+is expected, depending on the context and the r-value and l-value
+interpretation of the @code{VAR_DECL}.  The function
+@code{a68_consolidate_ref} is used in several parts of the lowering
+pass to guarantee a given name is an address regardless of how it was
+initialized.
+
+@node Procedure Identity Declarations
+@section Procedure Identity Declarations
+
+XXX
+
+@node Procedure Variable Declarations
+@section Procedure Variable Declarations
+
+XXX
+
+@node Operator Brief Declarations
+@section Operator Brief Declarations
+
+XXX
+
+@node Operator Declarations
+@section Operator Declarations
+
+XXX
+
+@node Applied Identifiers
+@section Applied Identifiers
+
+XXX
+
+@c ---------------------------------------------------------------------
+@c Lowering Assignations
+@c ---------------------------------------------------------------------
+
+@node Lowering Assignations
+@chapter Lowering Assignations
+
+Scope checking:
+
+@itemize @bullet
+@item
+If static scope checking is relevant and OK, then just perform assignation.
+@item
+If static scope checking is relevant and not OK, a compile-time error
+will have already being emitted.
+@item
+If static scope checking is not relevant, perform dynamic scope
+checking: each time a name, a routine or a format of the data
+structure is assigned, its dynamic scope (scope%_si) is compared with
+the one of the destination (scope%_d).  A run-time error message is
+provided in case scope%_d < scope%_si.
+@end itemize
+
+@c ---------------------------------------------------------------------
+@c GNU Free Documentation License
+@c ---------------------------------------------------------------------
+
+@include fdl.texi
+
+
+@c ---------------------------------------------------------------------
+@c Index
+@c ---------------------------------------------------------------------
+
+@node Index
+@unnumbered Index
+
+@printindex cp
+
+@bye
--- /dev/null
+++ b/src/gcc/algol68/ga68.texi
@@ -0,0 +1,3072 @@
+\input texinfo @c -*-texinfo-*-
+@setfilename ga68.info
+@settitle The GNU Algol 68 Compiler
+
+@c Macro for bold-tags.  In TeX and HTML they expand to proper bold words,
+@c in other formats it resorts to upper stropping.
+@iftex
+@macro B{tag}
+@strong{\tag\}
+@end macro
+@end iftex
+
+@ifhtml
+@macro B{tag}
+@strong{\tag\}
+@end macro
+@end ifhtml
+
+@ifnottex
+@ifnothtml
+@macro B{tag}
+@sc{\tag\}
+@end macro
+@end ifnothtml
+@end ifnottex
+
+@c Create a separate index for command line options
+@defcodeindex op
+@c Merge the standard indexes into a single one.
+@syncodeindex fn cp
+@syncodeindex vr cp
+@syncodeindex ky cp
+@syncodeindex pg cp
+@syncodeindex tp cp
+
+@include gcc-common.texi
+
+@c Copyright years for this manual.
+@set copyrights-ga68 2025
+
+@copying
+@c man begin COPYRIGHT
+Copyright @copyright{} @value{copyrights-ga68} 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
+* ga68: (ga68).               A GCC-based compiler for Algol 68
+@end direntry
+@end format
+
+@insertcopying
+@end ifinfo
+
+@titlepage
+@title The GNU Algol 68 Compiler
+@versionsubtitle
+@author Jose E. Marchesi
+
+@page
+@vskip 0pt plus 1filll
+@sp 1
+@insertcopying
+@end titlepage
+@summarycontents
+@contents
+@page
+
+@node Top
+@top Introduction
+
+This manual describes how to use @command{ga68}, the GNU compiler for
+Algol 68.  This manual is specifically about how to invoke
+@command{ga68}, as well as its features.  For more information about
+the Algol 68 language in general, the reader is referred to the
+bibliography.
+
+@menu
+* Invoking ga68::               How to run the compiler.
+* Composing programs::          Packets, modules, holes, particular programs.
+* Comments and pragmats::       Comments and pragmas.
+* Hardware representation::     Representation of programs.
+* Standard prelude::            Standard modes, operators, etc.
+* Extended prelude::            GNU extensions to the standard prelude.
+* POSIX prelude::               Simple I/O and system interaction facilities.
+* Language extensions::         GNU extensions to the Algol 68 language.
+* Copying::                     The GNU General Public License.
+* GNU Free Documentation License::
+                                How you can share and copy this manual.
+* Option Index::                Index of command line options.
+* General Index::               General index.
+@end menu
+
+@node Invoking ga68
+@chapter Invoking ga68
+
+@c man title ga68 A GCC-based compiler for Algol 68
+
+@ignore
+@c man begin SYNOPSIS ga68
+ga68 [@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{ga68} and @file{gcc}.
+@c man end
+@end ignore
+
+@c man begin DESCRIPTION ga68
+
+The @command{ga68} command is the GNU compiler for the Algol 68 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{ga68}.
+
+@c man end
+
+@menu
+* Dialect options::         Options controlling the accepted language.
+* Directory options::       Options influencing where to find source files.
+* Warnings options::        Options controlling warnings specific to ga68
+* Runtime options::         Options controlling runtime behavior
+* Linking options::         Options influencing the linking step
+* Developer options::       Options useful for developers of ga68
+@end menu
+
+@node Dialect options
+@section Dialect options
+@cindex options, dialect
+
+The following options control how the compiler handles certain dialect
+variations of the language.
+
+@table @gcctabopt
+@opindex std=@var{std}
+@item -std=@var{std}
+Specify the standard to which the program is expected to conform,
+which may be one of @samp{algol68} or @samp{gnu68}.  The default value
+for @var{std} is @samp{gnu68}, which specifies a strict super language
+of Algol 68 allowing GNU extensions.  The @samp{algol68} value
+specifies that the program strictly conform to the Revised Report.
+@opindex fstropping=@var{stropping_regime}
+@item -fstropping=@var{stropping_regime}
+Specify the stropping regime to expect in the input programs.  The
+default value for @var{stropping_regime} is @samp{supper}, which
+specifies the modern SUPPER stropping which is a GNU extension.  The
+@samp{upper} value specifies the classic UPPER stropping of Algol 68
+programs.  @xref{Stropping regimes}.
+@opindex fbrackets
+@opindex fno-brackets
+@item -fbrackets
+This option controls whether @code{[ .. ]} and @code{@{ .. @}} are
+considered equivalent to @code{( .. )}.  This syntactic variation is
+blessed by the Revised Report and is still strict Algol 68.
+
+This option is disabled by default.
+@end table
+
+@node Directory options
+@section Options for Directory Search
+@cindex directory options
+@cindex options, directory search
+@cindex search path
+
+These options specify directories to search for files, libraries, and
+other parts of the compiler:
+
+@table @gcctabopt
+
+@opindex I
+@item -I@var{dir}
+Add the directory @var{dir} to the list of directories to be searched
+for files when processing the @ref{pragmat include}. Multiple
+@option{-I} options can be used, and the directories specified are
+scanned in left-to-right order, as with @command{gcc}.
+
+@end table
+
+@node Warnings options
+@section Warnings options
+@cindex options, warnings
+@cindex options, errors
+@cindex warnings, suppressing
+@cindex messages, error
+@cindex messages, warning
+@cindex suppressing warnings
+
+Warnings are diagnostic messages that report constructions that
+are not inherently erroneous but that are risky or suggest there
+is likely to be a bug in the program.  Unless @option{-Werror} is
+specified, they do not prevent compilation of the program.
+
+@table @gcctabopt
+@opindex Wvoiding
+@opindex Wno-voiding
+@item -Wvoiding
+Warn on non-void units being voided due to a strong context.
+@opindex Wscope
+@opindex Wno-scope
+@item -Wscope
+Warn when a potential name scope violation is found.
+@opindex Whidden-declarations
+@opindex Wno-hidden-declarations
+@item -Whidden-declarations
+Warn when a declaration hides another declaration in a larger reach.
+This includes operators that hide firmly related operators defined in
+larger reach.
+@opindex Wextensions
+@opindex Wno-extensions
+@item -Wextensions
+Warn when a non-portable Algol 68 construct is used, like GNU
+extensions to Algol 68.
+@end table
+
+@node Runtime options
+@section Runtime options
+@cindex options, runtime
+
+These options affect the runtime behavior of programs compiled with
+@command{ga68}.
+
+@table @gcctabopt
+@opindex fa68-assert
+@opindex fno-a68-assert
+@item -fno-a68-assert
+Turn off code generation for @code{ASSERT} contracts.
+
+@opindex fa68-nil-checking
+@opindex fno-a68-nil-checking
+@item -fa68-nil-checking
+Turn on code generation of run-time checks for NIL while
+dereferencing.
+
+@opindex fa68-bounds-checking
+@opindex fno-a68-bounds-checking
+@item -fno-a68-bounds-checking
+Turn off code generation of run-time array bounds checks while
+slicing.
+@end table
+
+@node Linking options
+@section Linking options
+@cindex options, linking
+@cindex linking, static
+
+These options come into play when the compiler links object files into
+an executable output file.  They are meaningless if the compiler is
+not doing a link step.
+
+@table @gcctabopt
+
+@opindex shared-libga68
+@item -shared-libga68
+On systems that provide @file{libga68} as a shared and a static
+library, this option forces the use of the shared version.  If no
+shared version was built when the compiler was configured, this option
+has no effect.
+
+@opindex static-libga68
+@item -static-libga68
+On systems that provide @file{libga68} as a shared and a static
+library, this option forces the use of the static version.  If no
+static version was built when the compiler was configured, this option
+has no effect.  This is the default.
+@end table
+
+@node Developer options
+@section Developer options
+@cindex developer options
+@cindex debug dump options
+@cindex dump options
+
+This section describes command-line options that are primarily of
+interest to developers.
+
+@table @gcctabopt
+@opindex fdump-algol68-modes
+@item -fdump-algol68-modes
+Output a list of all the modes parsed by the front-end.
+
+@opindex fdump-algol68-tree
+@item -fdump-algol68-tree
+Dump a textual representation of the parse tree.
+@end table
+
+@node Composing programs
+@chapter Composing programs
+@cindex program
+@cindex separated compilation
+
+This chapter documents how to compose full Algol 68 programs using the
+modules and separated compilation support provided by this compiler.
+
+@menu
+* Packets::                  Compilation units.
+* Modules::                  Facilities for bottom-up programming.
+* Holes::                    Facilities for top-down programming.
+* Particular programs::      The main program.
+* The standard environment:: Environment conforming a full program.
+@end menu
+
+@node Packets
+@section Packets
+@cindex packet
+@cindex compilation unit
+
+Each Algol 68 source file contains a @dfn{packet}.  Packets therefore
+play the role of @dfn{compilation units}, and each packet can be
+compiled separately to an object file.  A set of compiled object files
+can then be linked in the usual fashion into an executable, archive or
+shared object by the system linker, without the need of any
+language-specific link editor or build system.
+
+@noindent
+This compiler supports three different kind of packets:
+
+@itemize @minus
+@item
+@dfn{Particular programs} constitute the entry point of a program.
+They correspond to the @code{main} function of other languages like C.
+
+@xref{Particular programs}.
+
+@item
+@dfn{Prelude packets} contain the definition of one or more modules,
+which @dfn{publicize} definitions of modes, procedures, variables,
+operators and even the publicized definitions of other modules.  The
+modules defined at the top-level of a prelude packet can be accessed
+by other packets via an @code{@B{access}} construct.  Prelude packets
+are so-called because their contents get stuffed in the
+@dfn{user-prelude} in the case of user-defined modules, or the
+@dfn{library-prelude} in the case of module packets provided by the
+compiler.  They are usually used to compose libraries that can be used
+in a bottom-up fashion.
+
+@xref{Modules}.
+
+@item
+@dfn{Stuffing packets} contain the definition of an @dfn{actual hole},
+an @code{@B{egg}} construct, that can be stuffed in a matching
+@dfn{formal hole} in another package via a @code{@B{nest}} construct.
+Formal holes are used in order to achieve separated compilation in a
+top-bottom fashion, and also to invoke procedures written in other
+languages, such as C functions or Fortran subroutines.
+
+@xref{Holes}.
+@end itemize
+
+A @dfn{collection of packets}, all of which must be compatible with
+each other, constitutes either a @dfn{program} or a @dfn{library}.
+Exactly one of the packets constituting a program shall be a
+particular program.  In libraries at least one packet must be a
+prelude packet.
+
+@node Modules
+@section Modules
+@cindex module
+
+@dfn{Definition modules}, often referred as just @dfn{modules} in the
+sequel, fulfill two different but related purposes.  On one side, they
+provide some degree of @dfn{protection} by preventing accessing
+indicators defined within the module but not explicitly publicized.
+On the other, they allow to define @dfn{interfaces}, allow separated
+compilation based on these interfaces, and conform libraries.
+
+Modules are usually associated with bottom-up development strategies,
+where several already written components are grouped and combined to
+conform bigger components.
+
+@menu
+* Writing modules::                Writing modules.
+* Accessing modules::              Using the definitions of a module.
+* Module activation::              How and when modules execute.
+* Modules and libraries::          Using modules to conform libraries.
+* Modules and protection::         When block structure is not enough.
+@end menu
+
+@node Writing modules
+@subsection Writing modules
+
+A @dfn{definition module} is a construct that provides access to a set
+of publicized definitions.  They can appear anywhere, but are
+typically found in the outer reach and compiled separately, in which
+case they conform a prelude packet (@pxref{Packets}).  They are
+composed of a prelude and a postlude.  The publicized definitions
+appear in the module's prelude.
+
+Consider for example the following definition module, which implements
+a very simple logging facility:
+
+@example
+@B{module} @B{logger} =
+   @B{def} @B{int} fd = stderr;
+       @B{pub} @B{string} originator;
+       @B{pub} @B{proc} log = (@B{string} msg) @B{void}:
+              fputs (fd, (originator /= "" | ": ") + msg + "\n");
+
+       log ("beginning of log\n");
+   @B{postlude}
+       log ("end of log\n");
+   @B{fed}
+@end example
+
+@noindent
+The @dfn{module text} delimited by @code{@B{def}} and @code{@B{fed}}
+gets ascribed to the module indicator @code{@B{logger}}.  Module
+indicators are bold tags.  Once defined, the module @code{@B{logger}}
+is accessible anywhere within its reach.
+
+The @dfn{prelude} of the module spans from @code{@B{def}} to either
+@code{@B{postlude}}, or to @code{@B{fed}} in case of modules not
+featuring a postlude.  It consists on a restricted serial clause in a
+void strong context, which can contain units and declarations, but no
+labels or completers.  The declarations in the prelude may be either
+publicized or no publicized.  As we shall see, publicized indicators
+are accessible within the reach of the defining module publicizing
+them.  Publicized declarations are marked by preceding them with
+@code{@B{pub}}.
+
+In our example the module prelude consists on three declarations and
+one unit.  The indicator @code{fd} is not publicized and is to be used
+internally by the module.  The indicators @code{originator} and
+@code{log}, on the other hand, are publicized and conform the
+interface of the module.  Note how the range of the prelude also
+covers the postlude: the @code{log} procedure is reachable there, as
+it would be @code{fd} as well.
+
+The @dfn{postlude} of the module is optional and spans from
+@code{@B{postlude}} to @code{@B{fed}}.  It consists on a serial clause
+in a @code{@B{void}} strong context, where definitions, labels and
+module accesses are not allowed, just units.
+
+@node Accessing modules
+@subsection Accessing modules
+
+Once a module is defined (@pxref{Writing modules}) it can be accessed,
+provided it is within reach, using an @dfn{access clause}.  The access
+clause identifies the modules to access and then makes the publicized
+definitions of these modules visible within a @dfn{control clause}.
+
+For example, this is how we could use the logger definition module
+defined in a previous section to log the progress of some program that
+reads an input file and writes some output file:
+
+@example
+@B{access} @B{logger}
+@B{begin} # Identify ourselves with the program name #
+      originator := argv (1);
+
+      # Read input file.  #
+      @B{if} @B{not} parse input (argv (2))
+      @B{then} log ("error parsing input file"); stop @B{fi};
+
+      # Write output file.  #
+      @B{if} @B{not} write output (argv (3))
+      @B{then} log ("error writing output file"); stop @B{fi};
+
+      log ("success")
+@B{end}
+@end example
+
+@noindent
+In this case the controlled clause is the closed clause conforming the
+particular program, and the definitions publicized by the logger
+module, in this case @code{originator} and @code{log}, can be used
+within it.
+
+@subsubsection Accessing several modules
+
+An access clause is not restricted to just provide access to a single
+module: any number of module indicators can be specified in an access
+clause.  Suppose that our example processing program has to read and
+write the data in JSON format, and that a suitable JSON library is
+available in the form of a reachable module.  We could then make both
+logger and json modules accessible like this:
+
+@example
+@B{access} @B{logger}, @B{json}
+@B{begin} # Identify ourselves with the program name #
+      originator := argv (1);
+
+      @B{jsonval} data;
+
+      # Read input file.  #
+      @B{if} data := json from file (argv (2));
+         data = json no val
+      @B{then} log ("error parsing input file"); stop @B{fi};
+
+      # Write output file.  #
+      @B{if} @B{not} json to file (argv (3), data)
+      @B{then} log ("error writing output file"); stop @B{fi};
+
+      log ("success")
+@B{end}
+@end example
+
+@noindent
+In this version of the program the access clause includes the module
+indicator @code{@B{json}}, and that makes the mode indicator
+@code{@B{jsonval}} and the tags @code{@B{json no val}}, @code{json
+from file} and @code{json to file} visible within the program's
+closed clause.
+
+Note that the following two access clauses are not equivalent:
+
+@example
+@B{access} @B{logger}, @B{json} @B{c} ... @B{c};
+@B{access} @B{logger} @B{access} @B{json} @B{c} ... @B{c};
+@end example
+
+@noindent
+In the first case, a compilation time error is emitted if there is a
+conflict among the publicized definitions of both modules; for
+example, if both modules were to publicize a procedure called
+@code{log}.  In the second case, the declaration of @code{log}
+publicized by @code{@B{logger}} would hide the declaration of
+@code{log} publicized by @code{@B{json}}.  This also has implications
+related to activation, that we will be discussing in a later section.
+
+@subsubsection The controlled clause
+
+The controlled clause in an access clause doesn't have to be a serial
+clause, like in the examples above.  It can be any enclosed clause,
+like for example a loop clause:
+
+@example
+@B{proc} frobnicate frobs = ([]@B{frob} frobs) @B{void}:
+   @B{access} @B{logger} @B{to} @B{upb} frobs
+                 @B{do} log ("frobnicating " + name @B{of} frob);
+                    frobnicate (frob)
+                 @B{od}
+@end example
+
+@subsubsection The value yielded by an access clause
+
+The elaboration of an access clause yields a value, which is the value
+yielded by the elaboration of the controlled clause.  Since the later
+is an enclosed clause, coercions get passed into them whenever
+required, the usual fashion.
+
+We can see an example of this in the following procedure, whose body
+is a controlled closed clause that yields a @code{@B{real}} value:
+
+@example
+@B{proc} incr factor = (@B{ref}[]@B{real} factors, @B{int} idx) @B{real}:
+   @B{access} @B{logger} (log ("factor increased"); factors[idx] +:= 1.0)
+@end example
+
+@noindent
+Note how the access clause above is in a strong context requiring a
+value of mode @code{@B{real}}.  The value yielded by the access clause
+is the value yielded by the controlled enclosed clause, which in this
+case is a closed clause.  The strong context and required mode gets
+passed to the last unit of the closed clause (the assignation) which
+in this case yields a value of mode @code{@B{ref} @B{real}}.  The unit
+is coerced to @code{@B{real}} by dereferencing, and the resulting
+value becomes the value yielded by the access clause.
+
+@subsubsection Modules accessing other modules
+
+A definition module may itself access other modules.  This is done by
+placing the module text as a controlled clause of an access clause.
+Suppose we rewrite our logger module so it uses JSON internally to log
+JSON objects rather than raw strings.  We could do it this way:
+
+@example
+@B{module} @B{logger} =
+   @B{access} @B{json}
+   @B{def} @B{int} fd = stderr;
+       @B{pub} @B{string} originator;
+       @B{pub} @B{proc} log = (@B{string} msg) @B{void}:
+              fputs (fd, json array (json string (originator),
+                                     json string (msg)));
+
+       log (json string ("beginning of log\n"));
+   @B{postlude}
+       log (json string ("end of log\n"));
+   @B{fed}
+@end example
+
+@noindent
+Note how this version of @code{@B{logger}} uses a few definitions
+publicized by the @code{@B{json}} module.
+
+A program accessing @code{@B{logger}} will not see the definitions
+publicized by the @code{@B{json}} module.  If that is what we
+intended, for example to allow the users of the logger to tweak their
+own JSON, we would need to specify it this way:
+
+@example
+@B{module} @B{logger} =
+   @B{access} @B{pub} @B{json}
+   @B{def} @B{c} ...as before... @B{c} @B{fed}
+@end example
+
+@noindent
+In this version the definitions publicized by @code{@B{json}} become
+visible to programs accessing @code{@B{logger}}.
+
+@node Module activation
+@subsection Module activation
+
+In all the examples seen so far the modules were accessed just once.
+In these cases, accessing the module via an access-clause caused the
+@dfn{activation} of the module.
+
+Activating a module involves elaborating all the declarations and
+units that conform its prelude.  Depending on the particular module
+definition that gets activated, this may involve all sort of side
+effects, such as allocating space for values and initializing them,
+opening files, @i{etc}.  Once the modules specified in the access
+clause are successfully activated, the controlled clause gets
+elaborated itself, within the reach of all the publicized definitions
+by the activated modules as we saw in the last section.  Finally, once
+the controlled clause has been elaborated, the module gets
+@dfn{revoked} by elaborating the serial clause in its postlude.
+
+However, nothing prevents some given definition module to be accessed
+more than once in the same program.  The following program, that makes
+use of the @code{@B{logger}} module, exemplifies this:
+
+@example
+@B{access} @B{logger}
+@B{begin} originator := argv (1);
+      log ("executing program");
+      @B{c} ... @B{c}
+      @B{access} @B{logger} (originator := argv (1) + ":subtask";
+                     log ("doing subtask")
+                     @B{c} ... @B{c})
+@B{end}
+@end example
+
+@noindent
+In this program the module @code{@B{logger}} is accessed twice.  The
+code is obviously written assuming that the inner access clause
+triggers a new activation of the @code{@B{logger}} module, allocating
+new storage and executing its prelude.  This would result in the
+following log contents:
+
+@example
+a.out: beginning of log
+a.out: executing program
+a.out:subtask: beginning of log
+a.out:subtask: doing subtask
+a.out:subtask: end of log
+a.out: end of log
+@end example
+
+@noindent
+However, this is not what happens.  The module gets only activated
+once, as the result of the outer access clause.  The inner access
+clause just makes the publicized indicators visible in its controlled
+clause.  The actual resulting log output is:
+
+@example
+a.out: beginning of log
+a.out: executing program
+a.out:subtask: doing subtask
+a.out:subtask: end of log
+@end example
+
+@noindent
+Which is not what we intended.  Modules are not classes.  If we wanted
+the logger to support several originators that can be nested, we would
+need to add support for it in the definition module.  Something like:
+
+@example
+@B{module} @B{logger} =
+   @B{def} @B{int} fd = stderr, max originators = 10;
+       @B{int} orig := 0;
+       [max originators]@B{string} originators;
+
+       @B{pub} @B{proc} push originator = (@B{string} str) @B{void}:
+              (@B{assert} (orig < max originators);
+               orig +:= 1;
+               originators[orig] := str);
+       @B{pub} @B{proc} pop originator = @B{void}:
+              (@B{assert} (max originators > 0);
+               orig -:= 1);
+       @B{pub} @B{proc} log = (@B{string} msg) @B{void}:
+              fputs (fd, (originator[orig] /= "" | ": ") + msg + "\n");
+
+       log ("beginning of log\n");
+   @B{postlude}
+       log ("end of log\n");
+   @B{fed}
+@end example
+
+@noindent
+Note how in this version of @code{@B{logger}} @code{originators} acts
+as a stack of originator strings, and it is not publicized.  The
+management of the stack is done via a pair of publicized procedures
+@code{push originator} and @code{pop originator}.  Our program will
+now look like:
+
+@example
+@B{access} @B{logger}
+@B{begin} push originator (argv (1));
+      log ("executing program");
+      @B{c} ... @B{c}
+      @B{access} @B{logger} (push originator ("subtask");
+                     log ("doing subtask")
+                     @B{c} ... @B{c};
+                     pop originator)
+@B{end}
+@end example
+
+@noindent
+And the log output is:
+
+@example
+a.out: beginning of log
+a.out: executing program
+a.out:subtask: doing subtask
+a.out: end of log
+@end example
+
+
+--------------------------------------------------------------
+
+module-indications are used to find interface-definitions of modules:
+
+  ACCESS FOO SKIP
+
+Looks for (in order):
+
+  foo.m68
+  foo.o
+  libfoo.so
+
+Should we use instead:
+
+  ACCESS "foo" SKIP
+
+That would use for module indicators the same syntax than hole
+indicators.
+
+Modules get accessed, invoked and revoked.
+
+Access clauses:
+
+: ACCESS A, B <enclosed clause>
+
+Where A and B are ``revelations''.
+
+In
+
+: MODULE A = ACCESS B DEF ... FED
+
+Doesn't reveals any contents of B.  Whereas in:
+
+: MODULE A = ACCESS PUB B DEF .. FED
+
+The module A is also revealing B's public declarations.  So accessing
+A provides access to B.
+
+User-defined preludes go to the user-prelude.
+
+Invocation and revocation:: How modules are executed.
+
+It is possible for a definition module to not publicize any
+definition.  Such modules would be used only for the side effects
+produced from executing the prelude and postlude when the module gets
+invoked and revoked. XXX: provide an example?
+
+XXX
+
+@node Modules and libraries
+@subsection Modules and libraries
+@cindex library
+@cindex prelude packet
+
+XXX
+
+@node Modules and protection
+@subsection Modules and protection
+@cindex protection
+@cindex publicized definition
+
+XXX
+
+@node Holes
+@section Holes
+@cindex hole
+
+XXX
+
+@node Particular programs
+@section Particular programs
+@cindex particular program
+
+An Algol 68 @dfn{particular program} consists on an enclosed clause in
+a strong context with target mode @code{@B{void}}, possibly preceded
+by a set of zero of more labels.  For example:
+
+@example
+hello:
+@B{begin} puts ("Hello, world!\n")
+@B{end}
+@end example
+
+@noindent
+Note that the enclosed clause conforming the particular program
+doesn't have to be a closed clause.  Consider for example the
+following program, that prints out its command line arguments:
+
+@example
+@B{for} i @B{to} argc
+@B{do} puts (argv (i) + "\n") @B{od}
+@end example
+
+@menu
+* Exit status::              How do programs communicate success or failure.
+@end menu
+
+@node Exit status
+@subsection Exit status
+@cindex exit status
+
+Some operating systems have the notion of @dfn{exit status} of a
+process.  In such systems, by default the execution of the particular
+program results in an exit status of success.  It is possible for the
+program to specify an explicit exit status by using the standard
+procedure @code{set exit status}, like:
+
+@example
+@b{begin} # ... program code ... #
+     @B{if} error found;
+     @B{then} set exit status (1) @B{fi}
+@b{end}
+@end example
+
+In POSIX systems the status is an integer, and the system interprets a
+value other than zero as a run-time error.  In other systems the
+status may be of some other type.  To support this, the @code{set
+error status} procedure accepts as an argument an united value that
+accommodates all the supported systems.
+
+The following example shows a very simple program that prints ``Hello
+world'' on the standard output and then returns to the operating
+system with a success status:
+
+@example
+@B{begin} puts ("Hello world\n")
+@B{end}
+@end example
+
+@node The standard environment
+@section The standard environment
+@cindex standard environment
+
+The environment in which particular programs run is expressed here in
+the form of pseudo code:
+
+@example
+(@B{c} standard-prelude @B{c};
+ @B{c} library-prelude @B{c};
+ @B{c} system-prelude @B{c};
+ @B{par} @B{begin} @B{c} system-task-1 @B{c},
+           @B{c} system-task-2 @B{c},
+           @B{c} system-task-n @B{c},
+           @B{c} user-task-1 @B{c},
+           @B{c} user-task-2 @B{c},
+           @B{c} user-task-m @B{c}
+     @B{end})
+@end example
+
+@noindent
+Where each user task consists on:
+
+@example
+(@B{c} particular-prelude @B{c};
+ @B{c} user-prelude @B{c};
+ @B{c} particular-program @B{c};
+ @B{c} particular-postlude @B{c})
+@end example
+
+The only standard system task described in the report is expressed in
+pseudo-code as:
+
+@example
+@B{do} @B{down} gremlins; undefined; @B{up} bfileprotect @B{od}
+@end example
+
+@noindent
+Which denotes that, once a book (file) is closed, anything may happen.
+Other system tasks may exist, depending on the operating system.  In
+general these tasks in the parallel clause denote the fact that the
+operating system is running in parallel (intercalated) with the user's
+particular programs.
+
+@itemize @bullet
+@item
+The library-prelude contains, among other things, the prelude parts of
+the defining modules provided by library.
+
+@item
+The particular-prelude and particular-postlude are common to all the
+particular programs.
+
+@item
+The user-prelude is where the prelude parts of the defining modules
+involved in the compilation get stuffed.  If no defining module is
+involved then the user-prelude is empty.
+@end itemize
+
+Subsequent sections in this manual include a detailed description of
+the contents of these preludes.
+
+@node Comments and pragmats
+@chapter Comments and pragmats
+
+Comments and pragmats, also known collectively as @dfn{pragments}, can
+appear almost anywhere in an Algol 68 program.  Comments are usually
+used for documentation purposes, and pragmats contain annotations for
+the compiler.  Both are handled at the lexical level.
+
+@menu
+* Comments::                    Your typical friendly comments.
+* Pragmats::                    In-source directives for the compiler.
+@end menu
+
+@node Comments
+@section Comments
+
+In the default modern stropping regime comments are written between
+@code{@{} and @code{@}} delimiters, and can be nested to arbitrary
+depth.  For example:
+
+@example
+foo +:= 1; @{ Increment foo.  @}
+@end example
+
+If UPPER stropping is selected, this compiler additionally supports
+three classical Algol 68 comment styles, in which the symbols marking
+the beginning of comments are the same than the symbols marking the
+end of comments and therefore can't be nested: @code{@B{comment}
+... @B{comment}}, @code{@B{co} ... @B{co}} and @code{# .. #}.  For
+example:
+
+@example
+@B{comment}
+  This is a comment.
+@B{comment}
+
+foo := 10; @B{co} this is also a comment @B{co}
+foo +:= 1; # and so is this.  #
+@end example
+
+Unless @option{-std=algol68} is specified in the command line, two
+styles of nestable comments can be also used with UPPER stropping: the
+already explained @code{@{ ... @}} and a ``bold'' style that uses
+@code{@B{code} ... @B{edoc}}.  For example:
+
+@example
+foo := 10; @{ this is a nestable comment in brief style.  @}
+foo +:= 1; @B{note} this is a nestable comment in bold style.  @B{eton}.
+@end example
+
+@example
+@B{note}
+   "Bold" nestable comments.
+@B{eton}
+
+@{ "Brief" nestable comments. @}
+@end example
+
+In UPPER stropping all comment styles are available, both classic and
+nestable.  In modern SUPPER stropping, which is based on reserved
+words, only @code{# ... #} is available.
+
+@node Pragmats
+@section Pragmats
+
+@cindex pragmat
+@dfn{Pragmats} (also known as @dfn{pragmas} in other programming
+languages) are directives and annotations for the compiler, and they
+impact the compilation process in several ways.  A pragmat starts with
+either @code{@B{pragmat}} or @code{@B{pr}} and finished with either
+@code{@B{pragmat}} or @code{@B{pr}} respectively.  Pragmats cannot be
+nested.  For example:
+
+@example
+@B{pr} include "foo.a68" @B{pr}
+@end example
+
+The interpretation of pragmats is compiler-specific.  This chapter
+documents the pragmats supported by GCC.
+
+@menu
+* pragmat include::         Include another source file.
+@end menu
+
+@node pragmat include
+@subsection pragmat include
+@cindex include
+
+An @dfn{include pragmat} has the form:
+
+@example
+@B{pr} include "PATH" @B{pr}
+@end example
+
+@noindent
+Where @code{PATH} is the path of the file whose contents are to be
+included at the location of the pragmat.  If the provided path is
+relative then it is interpreted as relative to the directory
+containing the source file that contains the pragmat.
+
+@node Hardware representation
+@chapter Hardware representation
+
+The @dfn{reference language} specified by the Revised Report describes
+Algol 68 particular programs as composed by @dfn{symbols}.  However,
+the Report leaves the matter of the concrete representation of these
+symbols, the @dfn{representation language}, open to the several
+implementations.  This was motivated by the very heterogeneous
+computer systems in existence at the time the Report was written.
+Flexibility in terms of representation was crucial.
+
+This flexibility was indeed exploited by the early implementations,
+and there was a price to pay for it.  A few years after the
+publication of the Revised Report the different implementations had
+already given rise to a plethora of many related languages that,
+albeit being strict Algol 68, differed considerably in appearance.
+This, and the fact that people were already engrossed in writing
+programs other than compilers that needed to process Algol 68
+programs, such as code formatters and macro processors, prompted the
+WG 2.1 to develop and publish a @dfn{Report on the Standard Hardware
+Representation for ALGOL 68}, which came out in 1975.
+
+This compiler follows the Standard Hardware Representation, but
+deviates from it in a few aspects.  This chapter provides an overview
+of the hardware representation and documents any deviation.
+
+@menu
+* Representation languages::  From symbols to syntactic marks.
+* Worthy characters::         Marks that can appear in a program.
+* Base characters::           Mapping of worthy characters to code points.
+* Stropping regimes::         Representation of bold words.
+* Monads and Nomads::         Characters that can appear in operator names.
+* String breaks::             String literals and escape sequences.
+@end menu
+
+@node Representation languages
+@section Representation languages
+
+A program in the strict Algol 68 language is composed by a series of
+symbols.  These symbols have names such as @code{letter-a-symbol} and
+@code{assigns-to-symbol} which are, well, purely symbolic. In fact,
+these are notions in the two-level grammar that defines the strict
+language.
+
+A @dfn{representation language} provides a mapping between symbols in
+the strict language and the representation of these symbols.  Each
+representation is a sequence of syntactic marks.  For example, the
+@code{completion symbol} may be represented by @strong{exit}, where
+the marks are the bold letters.  The @code{tilde symbol} may be
+represented by @code{~}, which is a single mark. The representation of
+@code{assigns to symbol} is @code{:=}, which is composed by the two
+marks @code{:} and @code{=}.  The representation of @code{letter-a}
+is, not surprising, the single mark @code{a}.
+
+The section 9.4 of the Report describes the recommended representation
+for all the symbols of the language, which constitutes the so-called
+@dfn{reference language}. Algol 68 implementations are strongly
+encouraged to use representation languages which are similar enough to
+the reference language, but it is not mandatory.
+
+A representation language may specify more than one representation for
+a given symbol.  For example, in the reference language the @code{is
+not symbol} is represented by @strong{isnt}, @code{:/=:} and a variant
+of the later where the slash sign is superimposed on the equal sign.
+In this case, an implementation can choose to implement any number of
+the representations.
+
+Spaces, tabs and newlines are @dfn{typographical display features}
+that, when they appear between symbols, are of no significance an do
+not alter the meaning of the program.  However, when a space or a tab
+appear in string or character denotations, they represent the
+@code{space symbol} and the @code{tab symbol}
+respectively@footnote{The @code{tab symbol} is a GNU extension}.
+
+@node Worthy characters
+@section Worthy characters
+@cindex worthy characters
+
+The syntactic marks of a representation language, both symbols and
+typographical display features, are realized as a set of @dfn{worthy
+characters} and the newline. Effectively, an Algol 68 program is a
+sequence of @dfn{worthy characters} and newlines.  The worthy
+characters are:
+
+@example
+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
+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
+0 1 2 3 4 5 6 7 8 9
+space tab " # $ % & ' ( ) * + , - . / : ; < = >  @ [ \ ]
+^ _ | @ ! ? ~ @{ @}
+@end example
+
+Some of the characters above were considered unworthy by the original
+Standard Hardware Representation:
+
+@table @code
+@item !
+It was considered unworthy because many installations didn't have a
+vertical bar base character, and @code{!} was used as a base character
+for @code{|}.  Today every computer system features a vertical bar
+character, so @code{!} can qualify as a worthy character.
+@item &
+The Revised Report specifies that @code{&} is a monad, used as a
+symbol for the dyadic @code{@B{and}} operator.  The Standard Hardware
+representation decided to turn it into an unworthy character,
+motivated by the fact that no nomads existed for the other logical
+operators @code{@B{not}} and @code{@B{or}}, and also with the goal of
+maintaining the set of worthy characters as small as possible to
+improve portability.  Recognizing that the first motivation still
+holds, but not the second, this compiler re-instates @code{&} as a
+monad but doesn't use it as an alternative representation of the
+@code{@B{and}} operator.
+@item ~
+The Standard Hardware Representation vaguely cites some ``severe
+difficulties'' with the hardware representation of the tilde
+character.  Whatever these difficulties were at the time, they surely
+don't exist anymore.  This compiler recognizes @code{~} as a worthy
+character, and is used as a monad.
+@item ?
+The question mark character was omitted as a worthy character to limit
+the size of the worthy set.  This compiler recognizes @code{?} as a
+worthy character, and is used as a monad.
+@item \
+Back-slash wasn't included as a worthy character because back in 1975
+it wasn't supported in EBCDIC (it is now).  This compiler recognizes
+@code{\} as a worthy character, and it is used to introduce string
+breaks.
+@item tab
+This compiler recognizes the tabulator character as a worthy
+character, and it is used as a typographical display feature.
+@end table
+
+@node Base characters
+@section Base characters
+@cindex base characters
+
+The worthy characters described in the previous section are to be
+interpreted symbolically rather than visually.  The worthy character
+@code{|}, for example, is the vertical line character and generally
+looks the same in every system.  The worthy character @code{space} is
+obviously referred by a symbolic name.
+
+The actual visually distinguishable characters available in an
+installation are known as @dfn{base characters}.  The Standard
+Hardware Representation allows implementations the possibility of
+using two or more base characters to represent a single worthy
+character.  This was the case of the @code{|} character, which was
+represented in many implementations by either @code{|} or @code{!}.
+
+This compiler uses the set of base characters corresponding to the
+subset of the Unicode character set that maps one to one to the set of
+worthy characters described in the previous section:
+
+@example
+A-Z   65-90
+a-z   97-122
+space 32
+tab   9
+!     33
+"     34
+#     35
+$     36
+%     37
+&     38
+'     39
+(     40
+)     41
+*     42
++     43
+,     44
+-     45
+.     46
+/     47
+:     58
+;     59
+<     60
+=     61
+>     62
+?     63
+@@     64
+[     91
+\     92
+]     93
+^     94
+_     95
+|     124
+~     126
+@end example
+
+@node Stropping regimes
+@section Stropping regimes
+
+The Algol 68 reference language establishes that certain source
+constructs, namely mode indications and operator indications, consist
+in a sequence of @dfn{bold letters} and @dfn{bold digits}, known as a
+@dfn{bold word}.  In contrast, other constructs like identifiers,
+field selectors and labels are composed of regular or non-bold letters
+and digits, known as a @dfn{tag}.
+
+What is precisely a bold letter or digit, and how it differs from a
+non-bold letter or digit, is not specified by the Report.  This is no
+negligence, but a conscious effort at abstracting the definition of
+the so-called @dfn{strict language} from its representation.  This
+allows different representations of the same language.
+
+Some representations of Algol 68 are intended to be published in
+books, be it paper or electronic devices, and be consumed by persons.
+These are called @dfn{publication languages}.  In publication
+languages bold letters and digits are typically represented by actual
+bold alphanumeric typographic marks, or sometimes underlined
+alphanumeric marks.
+
+Other representations of Algol 68 are intended to be automatically
+processed by a computer.  These representations are called
+@dfn{hardware languages}.  Sometimes the hardware languages are also
+intended to be written and read by programmers; these are called
+@dfn{programming languages}.
+
+Unfortunately, computer systems today usually do not yet provide
+readily usable and ergonomic bold or underline alphanumeric marks,
+despite the existence of Unicode and modern and sophisticated editing
+environments.  The lack of appropriate input methods surely plays a
+role on this.  Thus, the programming representation languages of Algol
+68 should resort to a technique known as @dfn{stropping} in order to
+differentiate bold letters and digits from non-bold letters and
+digits.  The set of rules specifying the representation of these
+characters is called a @dfn{stropping regime}.
+
+There are three classical stropping regimes for Algol 68, which are
+standardized and specified in the Standard Hardware Representation
+normative document.  These are @dfn{POINT stropping}, @dfn{RES
+stropping} and @dfn{UPPER stropping}.  The following sections do a
+cursory tour over them; for more details the reader is referred to the
+Standard Hardware Representation.
+
+This compiler implements UPPER stropping and SUPPER stropping.
+
+@menu
+* POINT stropping::
+* RES stropping::
+* UPPER stropping::
+* SUPPER stropping::
+@end menu
+
+@node POINT stropping
+@subsection POINT stropping
+
+POINT stropping is in a way the most fundamental of the three standard
+regimes.  It was designed to work in installations with limited
+character sets that provide only one alphabet, one set of digits, and
+a very restricted set of other symbols.
+
+In POINT stropping a bold word is represented by its constituent
+letters and digits preceded by a point character.  For example, the
+symbol @code{bold begin symbol} in the strict language, which is
+represented as @strong{begin} in bold face in the reference language,
+would be represented as @code{.BEGIN} in POINT stropping.
+
+More examples are summarized in the following table.
+
+@multitable @columnfractions .33 .33 .33
+@headitem Strict language @tab Reference language @tab POINT stropping
+@item @code{true symbol} @tab @strong{true} @tab @code{.TRUE}
+@item @code{false symbol} @tab @strong{false} @tab @code{.FALSE}
+@item @code{integral symbol} @tab @strong{int} @tab @code{.INT}
+@item @code{completion symbol} @tab @strong{exit} @tab @code{.EXIT}
+@item @code{bold-letter-c-...} @tab @strong{crc32} @tab @code{.CRC32}
+@end multitable
+
+In POINT stropping a tag is represented by writing its constituent
+non-bold letters and digits in order.  But they are organized in
+several @dfn{taggles}.
+
+Each taggle is a sequence of one or more letters and digits,
+optionally followed by an underscore character.  For example, the tag
+@code{PRINT} is composed of a single taggle, but the tag
+@code{PRINT_TABLE} is composed of a first taggle @code{PRINT_}
+followed by a second taggle @code{TABLE}.
+
+To improve readability it is possible to insert zero or more white
+space characters between the taggles in a tag.  Therefore, the tag
+@code{PRINT_TABLE} could have been written @code{PRINT TABLE}, or even
+@code{PRINT_ TABLE}.  This is the reason why Algol 68 identifiers,
+labels and field selectors can and do usually feature white spaces in
+them.
+
+It is important to note that both the trailing underscore characters
+in taggles and the white spaces in a tag do not contribute anything to
+the denoted tag: these are just stropping artifacts aimed to improve
+readability.  Therefore @code{FOOBAR} @code{FOO BAR}, @code{FOO_BAR}
+and @code{FOO_BAR_} are all representations of the same tag, that
+represents the
+@code{letter-f-letter-o-letter-o-letter-b-letter-a-letter-r} language
+construct.
+
+Below is the text of an example Algol 68 procedure encoded in POINT
+stropping.
+
+@example
+.PROC RECSEL OUTPUT RECORDS = .VOID:
+.BEGIN .BITS FLAGS
+         := (INCLUDE DESCRIPTORS | REC F DESCRIPTOR | REC F NONE);
+       .RECRSET RES = REC DB QUERY (DB, RECUTL TYPE,
+                                    RECUTL QUICK, FLAGS);
+       .RECWRITER WRITER := REC WRITER FILE NEW (STDOUT);
+
+       SKIP COMMENTS .OF WRITER := .TRUE;
+       .IF RECUTL PRINT SEXPS
+       .THEN MODE .OF WRITER := REC WRITER SEXP .FI;
+       REC WRITE (WRITER, RES)
+.END
+@end example
+
+@node RES stropping
+@subsection RES stropping
+
+The early installations where Algol 68 ran not only featured a very
+restricted character set, but also suffered from limited storage and
+complex to use and time consuming input methods such as card punchers
+and readers.  It was important for the representation of programs to
+be as compact as possible.
+
+It is likely that is what motivated the introduction of the RES
+stropping regime.  As its name implies, it removes the need of
+stropping many bold words by introducing @dfn{reserved words}.
+
+A @dfn{reserved word} is one of the bold words specified in the
+section 9.4.1 of the Report as a representation of some symbol.
+Examples are @strong{at}, @strong{begin}, @strong{if}, @strong{int}
+and @strong{real}.
+
+RES stropping encodes bold words and tags like POINT stropping, but if
+a bold word is a reserved word then it can then be written without a
+preceding point, achieving this way a more compact, and easier to
+read, representation for programs.
+
+Introducing reserved words has the obvious disadvantage that some tags
+cannot be written the obvious way due to the possibility of conflicts.
+For example, to represent a tag @code{if} it is not possible to just
+write @code{IF}, because it conflicts with a reserved word, but this
+can be overcome easily (if not elegantly) by writing @code{IF_}
+instead.
+
+Below is the @code{recsel output records} procedure again, this time
+encoded in RES stropping.
+
+@example
+PROC RECSEL OUTPUT RECORDS = VOID:
+BEGIN BITS FLAGS
+         := (INCLUDE DESCRIPTORS | REC F DESCRIPTOR | REC F NONE);
+      .RECRSET RES = REC DB QUERY (DB, RECUTL TYPE,
+                                   RECUTL QUICK, FLAGS);
+      .RECWRITER WRITER := REC WRITER FILE NEW (STDOUT);
+
+      SKIP COMMENTS OF WRITER := TRUE;
+      IF RECUTL PRINT SEXPS
+      THEN MODE .OF WRITER := REC WRITER SEXP FI;
+      REC WRITE (WRITER, RES)
+END
+@end example
+
+Note how user-defined mode an operator indications still require
+explicit stropping.
+
+@node UPPER stropping
+@subsection UPPER stropping
+
+In time computers added support for more than one alphabet by
+introducing character sets with both upper and lower case letters,
+along with convenient ways to both input and display these.
+
+In UPPER stropping the bold letters in bold word are represented by
+upper-case letters, whereas the letters in tags are represented by
+lower-case letters.
+
+The notions of upper- and lower-case are not applicable to digits, but
+since the language syntax assures that it is not possible to have a
+bold word that starts with a digit, digits are considered to be bold
+if they follow a bold letter or another bold digit.
+
+Below is the @code{recsel output records} procedure again, this time
+encoded in UPPER stropping.
+
+@example
+PROC recsel output records = VOID:
+BEGIN BITS flags
+         := (include descriptors | rec f descriptor | rec f none);
+      RECRSET res = rec db query (db, recutl type,
+                                  recutl quick, flags);
+      RECWRITER writer := rec writer file new (stdout);
+
+      skip comments of writer := TRUE;
+      IF recutl print sexps
+      THEN mode OF writer := rec writer sexp FI;
+      rec write (writer, res)
+END
+@end example
+
+Note how in this regime it is almost never necessary to introduce bold
+tags with points.  All in all, it looks much more natural to
+contemporary readers.  UPPER stropping is in fact the stropping regime
+of choice today.  It is difficult to think of any reason why anyone
+would resort to use POINT or RES stropping.
+
+@node SUPPER stropping
+@subsection SUPPER stropping
+
+In the SUPPER stropping regime bold words are written by writing a
+sequence of one or more @dfn{taggles}. Each taggle is written by
+writing a letter followed by zero or more other letters and digits and
+is optionally followed by a trailing underscore character.  The first
+letter in a bold word shall be an upper-case letter.  The rest of the
+letters in the bold word may be either upper- or lower-case.
+
+For example, @code{RecRset}, @code{Rec_Rset} and @code{RECRset} are
+all different ways to represent the same mode indication.  This allows
+to recreate popular naming conventions such as @code{CamelCase}.
+
+As in the other stropping regimes, the casing of the letters and the
+underscore characters are not really part of the mode or operator
+indication.
+
+Operator indications are also bold words and are written in exactly
+the same way than mode indications, but it is usually better to always
+use upper-case letters in operator indications.  On one side, it looks
+better, especially in the case of dyadic operators where the asymmetry
+of, for example @code{Equal} would look odd, consider @code{m1 Equal
+m2} as opposed to @code{m1 EQUAL m2}.  On the other side, tools like
+editors can make use of this convention in order to highlight operator
+indications differently than mode indications.
+
+In the SUPPER stropping regime tags are written by writing a sequence
+of one or more @dfn{taggles}.  Each taggle is written by writing a
+letter followed by zero or more other letters and digits and is
+optionally followed by a trailing underscore character.  All letters
+in a tag shall be lower-case letters.
+
+For example, the identifier @code{list} is represented by a single
+taggle, and it is composed by the letters @code{l}, @code{i}, @code{s}
+and @code{t}, in order.  In the jargon of the strict language we would
+spell the tag as @code{letter-l-letter-i-letter-s-letter-t}.
+
+The label @code{found_zero} is represented by two taggles,
+@code{found_} and @code{zero}, and it is composed by the letters
+@code{f}, @code{o}, @code{u}, @code{n}, @code{d}, @code{z}, @code{e},
+@code{r} and @code{o}, in order.  In the jargon of the strict language
+we would spell the tag as @code{letter-f-letter-o-letter-u-letter-n
+-letter-d-letter-z-letter-e-letter-r-letter-o}.
+
+The identifier @code{crc_32} is likewise represented by two taggles,
+@code{crc_} and @code{32}.  Note how the second taggle contains only
+digits.  In the jargon of the strict language we would spell the tag
+as @code{letter-c-letter-r-letter-c-digit-three-digit-two}.
+
+The underscore characters are not really part of the tag, but part of
+the stropping.  For example, both @code{goto found_zero} and
+@code{goto foundzero} jump to the same label.
+
+The @code{recsel output records} procedure, encoded in SUPPER
+stropping, looks like below.
+
+@example
+proc recsel_output_records = void:
+begin bits flags
+        := (include_descriptors | rec_f_descriptor | rec_f_none);
+      RecRset res = rec_db_query (db, recutl_type,
+                                  recutl_uick, flags);
+      RecWriter writer := rec_writer_file_new (stdout);
+
+      skip_comments of writer := true;
+      if recutl_print_sexps
+      then mode_ of writer := rec_writer_sexp fi;
+      rec_write (writer, res)
+end
+@end example
+
+@node Monads and Nomads
+@section Monads and Nomads
+@cindex monads
+@cindex nomads
+
+Algol68 operators, be them predefined or defined by the programmer,
+can be referred via either bold tags or sequences of certain
+non-alphabetic symbols.  For example, the dyadic operator @code{+} is
+defined for many modes to perform addition, the monadic operator
+@code{@B{entier}} gets a real value and rounds it to an integral
+value, and the operator @code{:=:} is the identity relation.  Many
+operators provide both bold tag names and symbols names, like in the
+case of @code{:/=:} that can also be written as @code{@B{isnt}}.
+
+Bold tags are lexically well delimited, and if the same tag is used to
+refer to a monadic operator and to a dyadic operator, no ambiguity can
+arise.  For example, in the following program it is clear that the
+second instance of @code{@B{plus}} refers to the monadic operator, and
+the first instance refers to the dyadic operator@footnote{If one would
+write @code{@B{plusplus}}, it would be a third different bold tag.}.
+
+@example
+@B{op} @B{plus} = (@B{int} a, b) @B{int}: a + b,
+   @B{plus} = (@B{int} a): a;
+@B{int} val = 2 @B{plus} @B{plus} 3;
+@end example
+
+On the other hand, symbols are not lexically delimited as words, and
+one symbol can appear immediately following another symbol.  This can
+lead to ambiguities.  For example, if we were to define a C-like
+monadic operator @code{++} like:
+
+@example
+@B{op} ++ = (@B{ref} @B{int} a) @B{int}: (@B{int} t = a; a +:=1; t);
+@end example
+
+@noindent
+Then the expression @code{++a} would be ambiguous: is it @code{++a} or
+@code{+(+a)}?.  In a similar way, if we would use @code{++} as the
+name of a dyadic operator, an expression like @code{a++b} could be
+also interpreted as both @code{a++b} and @code{a+(+b)}.
+
+To avoid these problems Algol 68 divides the symbols which are
+suitable to appear in the name of an operator into two classes: monads
+and nomads.  @dfn{Monads} are symbols that can be used as monadic
+operators.  @dfn{Nomads} are symbols which can be used as both monadic
+or dyadic operators.  Given these two sets, the rules to conform a
+valid operator are:
+
+@itemize @minus
+@item A bold tag.
+@item Any monad.
+@item A monad followed by a nomad.
+@item A monad optionally followed by a nomad followed by either @code{:=} or @code{=:}, but not by both.
+@end itemize
+
+@noindent
+In the GNU Algol 68 compiler:
+
+@itemize @minus
+@item The set of monads is @code{%^&+-~!?}.
+@item The set of nomads is @code{></=*}.
+@end itemize
+
+@node String breaks
+@section String breaks
+
+The intrinsic value of each worthy character that appears inside a
+string denotation is itself.  The string @code{"/abc"}, for example,
+contains a slash character followed by the three letters @code{a},
+@code{b} and @code{c}.
+
+Sometimes, however, it becomes necessary to represent some non-worthy
+character in a string denotation.  In these cases, an escape
+convention has to be used to represent these extra string-items.  It
+is up to the implementation to decide this convention, and the only
+requirement imposed by the Standard Hardware Representation on this
+regard is that the character used to introduce escapes, the
+@dfn{escape character}, shall be the apostrophe.  This section
+documents the escape conventions implemented by the GNU compiler.
+
+Two characters have special meaning inside string denotations: double
+quote (@code{"}) and apostrophe (@code{'}).  The first finishes the
+string denotation, and the second starts a @dfn{string break}, which
+is the Algol 68 term for what is known as an ``escape sequence'' in
+other programming languages.  Two consecutive double-quote characters
+specify a single double-quote character.
+
+The following string breaks are recognized by this compiler:
+
+@table @code
+@item ''
+Apostrophe character @code{'}.
+@item 'n
+Newline character.
+@item 'f
+Form feed character.
+@item 'r
+Carriage return (no line feed).
+@item 't
+Tab.
+@item '(list of character codes separated by commas)
+The indicated characters, where each code has the form @code{uhhhh} or
+@code{Uhhhhhhhh}, where @code{hhhh} and @code{hhhhhhhh} are integers
+expressing the character code in hexadecimal.  The list must contain
+at least one entry.
+@end table
+
+A string break can appear as the single string-item in a character
+denotation, subject to the following restrictions:
+
+@itemize @bullet
+@item
+List of characters string breaks @code{'(...)} that contain more than
+one character code are not allowed in character denotations.  If the
+specified code point is not a valid Unicode character then the value
+of the denotation is @code{invalid char}.
+@end itemize
+
+@node Standard prelude
+@chapter Standard prelude
+@cindex prelude, standard
+
+The Algol 68 Revised Report defines an extensive set of standard
+modes, operators, procedures and values, collectively known as the
+@dfn{standard prelude}.
+
+The standard prelude is available to Algol 68 programs without needing
+to import any module.
+
+For brevity, in this section the pseudo-mode @code{@B{l}} represents a
+@dfn{shortsety}, i.e. a sequence of either zero or more
+@code{@B{LONG}} or zero or more @code{@B{SHORT}}.
+
+@menu
+* Environment enquiries::              Information about the implementation.
+* Standard modes::                     Modes defined by the standard prelude.
+* Standard priorities::                Priorities of all standard operators.
+* Rows operators::                     Rows and associated operations.
+* Boolean operators::                  Operations on boolean operands.
+* Integral operators::                 Operations on integral operands.
+* Real operators::                     Operations on real operands.
+* Character operators::                Operations on character operands.
+* String operators::                   Strings and associated operations.
+* Complex operators::                  Operations on complex operands.
+* Bits operators::                     Bits and associated operations.
+* Bytes operators::                    Bytes and associated operations.
+* Semaphore operators::                Synchronization operations.
+* Math procedures::                    Standard mathematical constants and functions.
+@end menu
+
+@node Environment enquiries
+@section Environment enquiries
+
+An @dfn{environment enquiry} is a constant or a procedure, whose
+elaboration yields a value that may be useful to the programmer, that
+reflects some characteristic of the particular implementation.  The
+values of these enquiries are also determined by the architecture and
+operating system targeted by the compiler.
+
+@deftypevr Constant @B{int} {int lengths}
+1 plus the number of extra lenghts of integers which are meaningful.
+@end deftypevr
+
+@deftypevr Constant @B{int} {int shorths}
+1 plus the number of extra shorths of integers which are meaningful.
+@end deftypevr
+
+@deftypevr Constant {@B{l} @B{int}} {L max int}
+The largest integral value.
+@end deftypevr
+
+@deftypevr Constant @B{int} {real lengths}
+1 plus the number of extra lenghts of real numbers which are
+meaningful.
+@end deftypevr
+
+@deftypevr Constant @B{int} {real shorths}
+1 plus the number of extra shorths of real numbers which are
+meaningful.
+@end deftypevr
+
+@deftypevr Constant {@B{l} @B{real}} {L max real}
+The largest real value.
+@end deftypevr
+
+@deftypevr Constant {@B{l} @B{real}} {L small real}
+The smallest real value such that both @code{1 + small real > 1} and
+@code{1 - small real < 1}.
+@end deftypevr
+
+@deftypevr Constant @B{int} {bits lengths}
+1 plus the number of extra widths of bits which are meaningful.
+@end deftypevr
+
+@deftypevr Constant @B{int} {bits shorths}
+1 plus the number of extra shorths of bits which are meaningful.
+@end deftypevr
+
+@deftypevr Constant @B{int} {bits width}
+@deftypevrx Constant @B{int} {long bits width}
+@deftypevrx Constant @B{int} {long long bits width}
+The number of bits in a @code{@B{bits}} value.
+@end deftypevr
+
+@deftypevr Constant @B{int} {bytes lengths}
+1 plus the number of extra widths of bytes which are meaningful.
+@end deftypevr
+
+@deftypevr Constant @B{int} {bytes shorths}
+1 plus the number of extra shorths of bytes which are meaningful.
+@end deftypevr
+
+@deftypevr Constant @B{int} {bytes width}
+@deftypevrx Constant @B{int} {long bytes width}
+@deftypevrx Constant @B{int} {long long bytes width}
+The number of chars in a @code{@B{bytes}} value.
+@end deftypevr
+
+@deftypevr Constant @B{int} {max abs char}
+The largest value which @code{@B{abs}} of a @code{@B{char}} can yield.
+@end deftypevr
+
+@deftypevr Constant @B{char} {null character}
+Some character.
+@end deftypevr
+
+@deftypevr Constant @B{char} flip
+@deftypevrx Constant @B{char} flop
+Characters used to represent @code{@B{true}} and @code{@B{false}}
+boolean values in textual transput.
+@end deftypevr
+
+@deftypevr Constant @B{char} {error char}
+Character used to represent the digit of a value resulting from a
+conversion error in textual transput.
+@end deftypevr
+
+@deftypevr Constant @B{char} blank
+The space character.
+@end deftypevr
+
+@deftypevr Constant {@B{l} @B{real}} {L pi}
+The number pi.
+@end deftypevr
+
+@node Standard modes
+@section Standard modes
+
+@deftp Mode @B{void}
+The only value of this mode is @code{@B{empty}}.
+@end deftp
+
+@deftp Mode @B{bool}
+Mode for the boolean truth values @code{@B{true}} and @code{@B{false}}.
+@end deftp
+
+@deftp Mode {@B{l} @B{int}}
+Modes for signed integral values.  Each @code{@B{long}} or
+@code{@B{short}} may increase or decrease the range of the domain,
+depending on the characteristics of the current target.  Further
+@code{@B{long}}s and @code{@B{short}}s may be specified with no
+effect.
+@end deftp
+
+@deftp Mode {@B{l} @B{real}}
+Modes for signed real values.  Each @code{@B{long}} may increase the
+upper range of the domain, depending on the characteristics of the
+current target.  Further @code{@B{long}}s may be specified but with no
+effect.
+@end deftp
+
+@deftp Mode @B{char}
+Mode for character values.  The character values are mapped one-to-one
+to code points in the 21-bit space of Unicode.
+@end deftp
+
+@deftp Mode @B{string} {= @B{flex}[1:0]@B{char}}
+Mode for sequences of characters.  This is implemented as a flexible
+row of @code{@B{char}} values.
+@end deftp
+
+@deftp Mode {@B{l} @B{compl}} {= @B{struct} (@B{real} re,im)}
+Modes for complex values.  Each @code{@B{long}} may increase the
+precision of both the real and imaginary parts of the numbers,
+depending on the characteristics of the current target.  Further
+@code{@B{long}}s may be specified with no effect.
+@end deftp
+
+@deftp Mode {@B{l} @B{bits}}
+Compact and efficient representation of a row of boolean values.  Each
+@code{@B{long}} may increase the number of booleans that can be packed
+in a bits, depending on the characteristics of the current target.
+@end deftp
+
+@deftp Mode {@B{l} @B{bytes}}
+Compact and efficient representation of a row of character values.
+Each @code{@B{long}} may increase the number of characters that can be
+packed in a bytes, depending on the characteristics of the current
+target.
+@end deftp
+
+@node Standard priorities
+@section Standard priorities
+
+@table @code
+@item 1
+@itemize @bullet
+@item @code{plusab}, @code{+:=}
+@item @code{minusab}, @code{-:=}
+@item @code{timesab}, @code{*:=}
+@item @code{divab}, @code{/:=}
+@item @code{overab}, @code{%:=}
+@item @code{modab}, @code{%*:=}
+@item @code{plusto}, @code{+=:}
+@end itemize
+
+@item 2
+@itemize @bullet
+@item @code{or}
+@end itemize
+
+@item 3
+@itemize @bullet
+@item @code{and}
+@item @code{xor}
+@end itemize
+
+@item 4
+@itemize @bullet
+@item @code{@B{eq}}, @code{=}
+@item @code{@B{ne}}, @code{/=}
+@end itemize
+
+@item  5
+@itemize @bullet
+@item @code{@B{lt}}, @code{<},
+@item @code{@B{le}}, @code{<=}
+@item @code{@B{gt}}, @code{>}
+@item @code{@B{ge}}, @code{>=}
+@end itemize
+
+@item 6
+@itemize @bullet
+@item @code{+}
+@item @code{-}
+@end itemize
+
+@item 7
+@itemize @bullet
+@item @code{*}
+@item @code{/}
+@item @code{@B{over}}, @code{%}
+@item @code{@B{mod}}, @code{%*}
+@item @code{@B{elem}}
+@end itemize
+
+@item 8
+@itemize @bullet
+@item @code{**}
+@item @code{@B{shl}}, @code{@B{up}}
+@item @code{@B{shr}}, @code{@B{down}}
+@item @code{@B{up}}, @code{@B{down}}
+@item @code{^}
+@item @code{@B{lwb}}
+@item @code{@B{upb}}
+@end itemize
+
+@item 9
+@itemize @bullet
+@item @code{@B{i}}
+@item @code{+*}
+@end itemize
+@end table
+
+@node Rows operators
+@section Rows operators
+
+The following operators work on any row mode, denoted below using the
+pseudo-mode @code{@B{rows}}.
+
+@deftypefn Operator {} {@B{lwb}} {= (@B{rows} a) @B{int}}
+Monadic operator that yields the lower bound of the first bound pair
+of the descriptor of the value of @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{upb}} {= (@B{rows} a) @B{int}}
+Monadic operator that yields the upper bound of the first bound pair
+of the descriptor of the value of @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{lwb}} {= (@B{int} n, @B{rows} a) @B{int}}
+Dyadic operator that yields the lower bound in the n-th bound pair of
+the descriptor of the value of @code{a}, if that bound pair exists.
+Attempting to access a non-existing bound pair results in a run-time
+error.
+@end deftypefn
+
+@deftypefn Operator {} {@B{upb}} {= (@B{int} n, @B{rows} a) @B{int}}
+Dyadic operator that yields the upper bound in the n-th bound pair of
+the descriptor of the value of @code{a}, if that bound pair exists.
+Attempting to access a non-existing bound pair results in a run-time
+error.
+@end deftypefn
+
+@node Boolean operators
+@section Boolean operators
+
+@deftypefn Operator {} {@B{not}} {= (@B{bool} a) @B{bool}}
+@deftypefnx Operator {} {~} {= (@B{bool} a) @B{bool}}
+Monadic operator that yields the logical negation of its operand.
+@end deftypefn
+
+@deftypefn Operator {} {@B{or}} {= (@B{bool} a, b) @B{bool}}
+Dyadic operator that yields the logical ``or'' of its operands.
+@end deftypefn
+
+@deftypefn Operator {} {@B{and}} {= (@B{bool} a, b) @B{bool}}
+@deftypefnx Operator {} {@B{&}} {= (@B{bool} a, b) @B{bool}}
+Dyadic operator that yields the logical ``and'' of its operands.
+@end deftypefn
+
+@deftypefn Operator {} {@B{eq}} {= (@B{bool} a, b) @B{bool}}
+@deftypefnx Operator {} {=} {= (@B{bool} a, b) @B{bool}}
+Dyadic operator that yields @code{@B{true}} if its operands are the
+same truth value, @code{@B{false}} otherwise.
+@end deftypefn
+
+@deftypefn Operator {} {@B{ne}} {= (@B{bool} a, b) @B{bool}}
+@deftypefnx Operator {} {/=} {= (@B{bool} a, b) @B{bool}}
+Dyadic operator that yields @code{@B{false}} if its operands are the
+same truth value, @code{@B{true}} otherwise.
+@end deftypefn
+
+@deftypefn Operator {} {@B{abs}} {= (@B{bool} a) @B{int}}
+Monadic operator that yields 1 if its operand is @code{@B{true}}, and
+0 if its operand is @code{@B{false}}.
+@end deftypefn
+
+@node Integral operators
+@section Integral operators
+
+@subsection Arithmetic
+
+@deftypefn Operator {} {+} {= (@B{l} @B{int} a) @B{l} @B{int}}
+Monadic operator that yields the affirmation of its operand.
+@end deftypefn
+
+@deftypefn Operator {} {-} {= (@B{l} @B{int} a) @B{l} @B{int}}
+Monadic operator that yields the negative of its operand.
+@end deftypefn
+
+@deftypefn Operator {} {@B{abs}} {= (@B{l} @B{int} a) @B{l} @B{int}}
+Monadic operator that yields the absolute value of its operand.
+@end deftypefn
+
+@deftypefn Operator {} {@B{sign}} {= (@B{l} @B{int} a) @B{int}}
+Monadic operator that yields -1 if @code{a} if negative, 0 if @code{a}
+is zero and 1 if @code{a} is positive.
+@end deftypefn
+
+@deftypefn Operator {} {@B{odd}} {= (@B{l} @B{int} a) @B{bool}}
+Monadic operator that yields @code{@B{true}} if its operand is odd,
+@code{@B{false}} otherwise.
+@end deftypefn
+
+@deftypefn Operator {} {+} {= (@B{l} @B{int} a, b) @B{l} @B{int}}
+Dyadic operator that yields the addition of its operands.
+@end deftypefn
+
+@deftypefn Operator {} {-} {= (@B{l} @B{int} a, b) @B{l} @B{int}}
+Dyadic operator that yields @code{b} subtracted from @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {*} {= (@B{l} @B{int} a, b) @B{l} @B{int}}
+Dyadic operator that yields the multiplication of its operands.
+@end deftypefn
+
+@deftypefn Operator {} {@B{over}} {= (@B{l} @B{int} a, b) @B{l} @B{int}}
+@deftypefnx Operator {} {%} {= (@B{l} @B{int} a, b) @B{l} @B{int}}
+Dyadic operator that yields the integer division of @code{a} by
+@code{b}, rounding the quotient toward zero.
+@end deftypefn
+
+@deftypefn Operator {} {@B{mod}} {= (@B{l} @B{int} a, b) @B{l} @B{int}}
+@deftypefnx Operator {} {%*} {= (@B{l} @B{int} a, b) @B{l} @B{int}}
+Dyadic operator that yields the remainder of the division of @code{a}
+by @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {/} {= (@B{l} @B{int} a, b) @B{l} @B{real}}
+Dyadic operator that yields the integer division with real result of
+@code{a} by @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {**} {= (@B{l} @B{int} a, b) @B{l} @B{int}}
+@deftypefnx Operator {} {^} {= (@B{l} @B{int} a, b) @B{l} @B{int}}
+Dyadic operator that yields @code{a} raised to the exponent @code{b}.
+@end deftypefn
+
+@subsection Arithmetic combined with assignation
+
+@deftypefn Operator {} {@B{plusab}} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}}
+@deftypefnx Operator {} {+:=} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}}
+@dfn{Plus and become}.  Dyadic operator that calculates @code{a + b},
+assigns the result of the operation to the name @code{a} and then
+yields @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{minusab}} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}}
+@deftypefnx Operator {} {-:=} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}}
+Dyadic operator that calculates @code{a - b}, assigns the result of
+the operation to the name @code{a} and then yields @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{timesab}} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}}
+@deftypefnx Operator {} {*:=} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}}
+Dyadic operator that calculates @code{a * b}, assigns the result of
+the operation to the name @code{a} and then yields @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{overab}} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}}
+@deftypefnx Operator {} {%:=} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}}
+Dyadic operator that calculates @code{a % b}, assigns the result of
+the operation to the name @code{a} and then yields @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{modab}} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}}
+@deftypefnx Operator {} {%*:=} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}}
+Dyadic operator that calculates @code{a %* b}, assigns the result of
+the operation to the name @code{a} and then yields @code{a}.
+@end deftypefn
+
+@subsection Relational
+
+@deftypefn Operator {} {@B{eq}} {= (@B{l} @B{int} a, b) @B{bool}}
+@deftypefnx Operator {} {=} {= (@B{l} @B{int} a, b) @B{bool}}
+Dyadic operator that yields whether its operands are equal.
+@end deftypefn
+
+@deftypefn Operator {} {@B{ne}} {= (@B{l} @B{int} a, b) @B{bool}}
+@deftypefnx Operator {} {/=} {= (@B{l} @B{int} a, b) @B{bool}}
+Dyadic operator that yields whether its operands are not equal.
+@end deftypefn
+
+@deftypefn Operator {} {@B{lt}} {= (@B{l} @B{int} a, b) @B{bool}}
+@deftypefnx Operator {} {<} {= (@B{l} @B{int} a, b) @B{bool}}
+Dyadic operator that yields whether @code{a} is less than @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{le}} {= (@B{l} @B{int} a, b) @B{bool}}
+@deftypefnx Operator {} {<=} {= (@B{l} @B{int} a, b) @B{bool}}
+Dyadic operator that yields whether @code{a} is less than, or equal to
+@code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{gt}} {= (@B{l} @B{int} a, b) @B{bool}}
+@deftypefnx Operator {} {>} {= (@B{l} @B{int} a, b) @B{bool}}
+Dyadic operator that yields whether @code{a} is greater than
+@code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{ge}} {= (@B{l} @B{int} a, b) @B{bool}}
+@deftypefnx Operator {} {>=} {= (@B{l} @B{int} a, b) @B{bool}}
+Dyadic operator that yields whether @code{a} is greater than, or equal
+to @code{b}.
+@end deftypefn
+
+@subsection Conversion
+
+@deftypefn Operator {} {@B{shorten}} {= (@B{short} @B{int} a) @B{short} @B{short} @B{int}}
+@deftypefnx Operator {} {@B{shorten}} {= (@B{int} a) @B{short} @B{int}}
+@deftypefnx Operator {} {@B{shorten}} {= (@B{long} @B{int} a) @B{int}}
+@deftypefnx Operator {} {@B{shorten}} {= (@B{long} @B{long} @B{int} a) @B{long} @B{int}}
+Monadic operator that yields, if it exists, the integral value that
+can be lengthened to the value of @code{a}.  If the value doesn't
+exist then the operator yields either the most positive integral value
+in the destination mode, if @code{a} is bigger than that value, or the
+most negative integral value in the destination mode, if @code{a} is
+smaller than that value.
+@end deftypefn
+
+@deftypefn Operator {} {@B{leng}} {= (@B{short} @B{short} @B{int} a) @B{short} @B{int}}
+@deftypefnx Operator {} {@B{leng}} {= (@B{short} @B{int} a) @B{int}}
+@deftypefnx Operator {} {@B{leng}} {= (@B{int} a) @B{long} @B{int}}
+@deftypefnx Operator {} {@B{leng}} {= (@B{long} @B{int} a) @B{long} @B{long} @B{int}}
+Monadic operator that yields the integral value lengthened from the
+value of @code{a}.
+@end deftypefn
+
+@node Real operators
+@section Real operators
+
+@subsection Arithmetic
+
+@deftypefn Operator {} {+} {= (@B{l} @B{real} a) @B{l} @B{real}}
+Monadic operator that yields the affirmation of its operand.
+@end deftypefn
+
+@deftypefn Operator {} {-} {= (@B{l} @B{real} a) @B{l} @B{real}}
+Monadic operator that yields the negative of its operand.
+@end deftypefn
+
+@deftypefn Operator {} {@B{abs}} {= (@B{l} @B{real} a) @B{l} @B{real}}
+Monadic operator that yields the absolute value of its operand.
+@end deftypefn
+
+@deftypefn Operator {} {@B{sign}} {= (@B{l} @B{real} a) @B{int}}
+Monadic operator that yields -1 if @code{a} if negative, 0 if @code{a}
+is zero and 1 if @code{a} is positive.
+@end deftypefn
+
+@deftypefn Operator {} {+} {= (@B{l} @B{real} a, b) @B{l} @B{real}}
+Dyadic operator that yields the addition of its operands.
+@end deftypefn
+
+@deftypefn Operator {} {-} {= (@B{l} @B{real} a, b) @B{l} @B{real}}
+Dyadic operator that yields @code{b} subtracted from @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {*} {= (@B{l} @B{real} a, b) @B{l} @B{real}}
+Dyadic operator that yields the multiplication of its operands.
+@end deftypefn
+
+@deftypefn Operator {} {/} {= (@B{l} @B{real} a, b) @B{l} @B{real}}
+Dyadic operator that yields the realeger division with real result of
+@code{a} by @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {**} {= (@B{l} @B{real} a, b) @B{l} @B{real}}
+@deftypefnx Operator {} {^} {= (@B{l} @B{real} a, b) @B{l} @B{real}}
+Dyadic operator that yields @code{a} raised to the real exponent @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {**} {= (@B{l} @B{real} a, @B{int} b) @B{l} @B{real}}
+@deftypefnx Operator {} {^} {= (@B{l} @B{real} a, @B{int} b) @B{l} @B{real}}
+Dyadic operator that yields @code{a} raised to the integral exponent
+@code{b}.
+@end deftypefn
+
+@subsection Arithmetic combined with assignation
+
+@deftypefn Operator {} {@B{plusab}} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}}
+@deftypefnx Operator {} {+:=} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}}
+@dfn{Plus and become}.  Dyadic operator that calculates @code{a + b},
+assigns the result of the operation to the name @code{a} and then
+yields @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{minusab}} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}}
+@deftypefnx Operator {} {-:=} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}}
+Dyadic operator that calculates @code{a - b}, assigns the result of
+the operation to the name @code{a} and then yields @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{timesab}} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}}
+@deftypefnx Operator {} {*:=} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}}
+Dyadic operator that calculates @code{a * b}, assigns the result of
+the operation to the name @code{a} and then yields @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{divab}} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}}
+@deftypefnx Operator {} {/:=} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}}
+Dyadic operator that calculates @code{a / b}, assigns the result of
+the operation to the name @code{a} and then yields @code{a}.
+@end deftypefn
+
+@subsection Relational
+
+@deftypefn Operator {} {@B{eq}} {= (@B{l} @B{real} a, b) @B{bool}}
+@deftypefnx Operator {} {=} {= (@B{l} @B{real} a, b) @B{bool}}
+Dyadic operator that yields whether its operands are equal.
+@end deftypefn
+
+@deftypefn Operator {} {@B{ne}} {= (@B{l} @B{real} a, b) @B{bool}}
+@deftypefnx Operator {} {/=} {= (@B{l} @B{real} a, b) @B{bool}}
+Dyadic operator that yields whether its operands are not equal.
+@end deftypefn
+
+@deftypefn Operator {} {@B{lt}} {= (@B{l} @B{real} a, b) @B{bool}}
+@deftypefnx Operator {} {<} {= (@B{l} @B{real} a, b) @B{bool}}
+Dyadic operator that yields whether @code{a} is less than @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{le}} {= (@B{l} @B{real} a, b) @B{bool}}
+@deftypefnx Operator {} {<=} {= (@B{l} @B{real} a, b) @B{bool}}
+Dyadic operator that yields whether @code{a} is less than, or equal to
+@code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{gt}} {= (@B{l} @B{real} a, b) @B{bool}}
+@deftypefnx Operator {} {>} {= (@B{l} @B{real} a, b) @B{bool}}
+Dyadic operator that yields whether @code{a} is greater than
+@code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{ge}} {= (@B{l} @B{real} a, b) @B{bool}}
+@deftypefnx Operator {} {>=} {= (@B{l} @B{real} a, b) @B{bool}}
+Dyadic operator that yields whether @code{a} is greater than, or equal
+to @code{b}.
+@end deftypefn
+
+@subsection Conversions
+
+@deftypefn Operator {} {@B{round}} {= (@B{l} @B{real} a) @B{int}}
+Monadic operator that yields the nearest integer to its operand.
+@end deftypefn
+
+@deftypefn Operator {} {@B{entier}} {= (@B{l} @B{real} a) @B{int}}
+Monadic operator that yields the integer equal to @code{a}, or the
+next integer below (more negative than) @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{shorten}} {= (@B{long} @B{real} a) @B{real}}
+@deftypefnx Operator {} {@B{shorten}} {= (@B{long} @B{long} @B{real} a) @B{long} @B{real}}
+Monadic operator that yields, if it exists, the real value that
+can be lengthened to the value of @code{a}.  If the value doesn't
+exist then the operator yields either the most positive real value
+in the destination mode, if @code{a} is bigger than that value, or the
+most negative real value in the destination mode, if @code{a} is
+smaller than that value.
+@end deftypefn
+
+@deftypefn Operator {} {@B{leng}} {= (@B{real} a) @B{long} @B{real}}
+@deftypefnx Operator {} {@B{leng}} {= (@B{long} @B{real} a) @B{long} @B{long} @B{real}}
+Monadic operator that yields the real value lengthened from the
+value of @code{a}.
+@end deftypefn
+
+@node Character operators
+@section Character operators
+
+@subsection Relational
+
+@deftypefn Operator {} {@B{eq}} {= (@B{char} a, b) @B{bool}}
+@deftypefnx Operator {} {=} {= (@B{char} a, b) @B{bool}}
+Dyadic operator that yields whether its operands are equal.
+@end deftypefn
+
+@deftypefn Operator {} {@B{ne}} {= (@B{char} a, b) @B{bool}}
+@deftypefnx Operator {} {/=} {= (@B{char} a, b) @B{bool}}
+Dyadic operator that yields whether its operands are not equal.
+@end deftypefn
+
+@deftypefn Operator {} {@B{lt}} {= (@B{char} a, b) @B{bool}}
+@deftypefnx Operator {} {<} {= (@B{char} a, b) @B{bool}}
+Dyadic operator that yields whether @code{a} is less than @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{le}} {= (@B{char} a, b) @B{bool}}
+@deftypefnx Operator {} {<=} {= (@B{char} a, b) @B{bool}}
+Dyadic operator that yields whether @code{a} is less than, or equal to
+@code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{gt}} {= (@B{char} a, b) @B{bool}}
+@deftypefnx Operator {} {>} {= (@B{char} a, b) @B{bool}}
+Dyadic operator that yields whether @code{a} is greater than @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{ge}} {= (@B{char} a, b) @B{bool}}
+@deftypefnx Operator {} {>=} {= (@B{char} a, b) @B{bool}}
+Dyadic operator that yields whether @code{a} is greater than, or equal
+to @code{b}.
+@end deftypefn
+
+@subsection Conversions
+
+@deftypefn Operator {} {@B{ABS}} {= (@B{char} a) @B{int}}
+Monadic operator that yields an unique integer for each permissable
+value of @code{@B{char}}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{REPR}} {= (@B{int} a) @B{char}}
+The opposite of @code{@B{abs}} of a character.
+@end deftypefn
+
+@node String operators
+@section String operators
+
+@subsection Relational
+
+@deftypefn Operator {} {@B{eq}} {= (@B{string} a, b) @B{bool}}
+@deftypefnx Operator {} {=} {= (@B{string} a, b) @B{bool}}
+Dyadic operator that yields whether its operands are equal.  Two
+strings are equal if they contain the same sequence of characters.
+@end deftypefn
+
+@deftypefn Operator {} {@B{ne}} {= (@B{string} a, b) @B{bool}}
+@deftypefnx Operator {} {/=} {= (@B{string} a, b) @B{bool}}
+Dyadic operator that yields whether its operands are not equal.
+@end deftypefn
+
+@deftypefn Operator {} {@B{lt}} {= (@B{string} a, b) @B{bool}}
+@deftypefnx Operator {} {<} {= (@B{string} a, b) @B{bool}}
+Dyadic operator that yields whether the string @code{a} is less than
+the string @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{le}} {= (@B{string} a, b) @B{bool}}
+@deftypefnx Operator {} {<=} {= (@B{string} a, b) @B{bool}}
+Dyadic operator that yields whether the string @code{a} is less than,
+or equal to string @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{gt}} {= (@B{string} a, b) @B{bool}}
+@deftypefnx Operator {} {>} {= (@B{string} a, b) @B{bool}}
+Dyadic operator that yields whether the string @code{a} is greater
+than the string @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{ge}} {= (@B{string} a, b) @B{bool}}
+@deftypefnx Operator {} {>=} {= (@B{string} a, b) @B{bool}}
+Dyadic operator that yields whether the string @code{a} is greater
+than, or equal to the string @code{b}.
+@end deftypefn
+
+@subsection Composition
+
+@deftypefn Operator {} {+} {= (@B{string} a, b) @B{string}}
+Dyadic operator that yields the concatenation of the two given
+strings as a new string.
+@end deftypefn
+
+@deftypefn Operator {} {+} {= (@B{string} a, @B{char} b) @B{string}}
+Dyadic operator that yields the concatenation of the given string
+@code{a} and a string whose contents are the character @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {*} (= (@B{int} a, @B{string} b) @B{string})
+@deftypefnx Operator {} {*} (= (@B{string} b, @B{int} a) @B{string})
+Dyadic operator that yields the string @code{a} concatenated @code{a}
+times to itself.  If @code{a} is less than zero then it is interpreted
+to be zero.
+@end deftypefn
+
+@subsection Composition combined with assignation
+
+@deftypefn Operator {} {@B{plusab}} {= (@B{ref} @B{string} a, @B{string} b) @B{ref} @B{string}}
+@deftypefnx Operator {} {+:=} {= (@B{ref} @B{string} a, @B{string} b) @B{ref} @B{string}}
+@dfn{Plus and become}.  Dyadic operator that calculates @code{a + b},
+assigns the result of the operation to the name @code{a} and then
+yields @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{plusto}} {= (@B{string} b, @B{ref} @B{string} a) @B{ref} @B{string}}
+@deftypefnx Operator {} {+=:} {= (@B{string} b, @B{ref} @B{string} b) @B{ref} @B{string}}
+Dyadic operator that calculates @code{a + b}, assigns the result of
+the operation to the name @code{a} and then yields @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{timesab}} {= (@B{ref} @B{string} a, @B{string} b) @B{ref} @B{string}}
+@deftypefnx Operator {} {*:=} {= (@B{ref} @B{string} a, @B{string} b) @B{ref} @B{stringl}}
+@dfn{Plus and become}.  Dyadic operator that calculates @code{a * b},
+assigns the result of the operation to the name @code{a} and then
+yields @code{a}.
+@end deftypefn
+
+@node Complex operators
+@section Complex operators
+
+@node Bits operators
+@section Bits operators
+
+@subsection Logical
+
+@deftypefn Operator {} {@B{NOT}} {= (@B{l} @B{bits} a, b) @B{l} @B{bits}}
+@deftypefnx Operator {} {~} {= (@B{l} @B{bits} a, b) @B{l} @B{bits}}
+Monadic operator that yields the element-wise not logical operation in
+the elements of the given bits operand.
+@end deftypefn
+
+@deftypefn Operator {} {@B{AND}} {= (@B{l} @B{bits} a, b) @B{l} @B{bits}}
+@deftypefnx Operator {} {&} {= (@B{l} @B{bits} a, b) @B{l} @B{bits}}
+Dyadic operator that yields the element-wise and logical operation in
+the elements of the given bits operands.
+@end deftypefn
+
+@deftypefn Operator {} {@B{OR}} {= (@B{l} @B{bits} a, b) @B{l} @B{bits}}
+Dyadic operator that yields the element-wise ``or'' logical operation
+in the elements of the given bits operands.
+@end deftypefn
+
+@subsection Shifting
+
+@deftypefn Operator {} {@B{SHL}} {= (@B{l} @B{bits} a, @B{int} n) @B{l} @B{bits}}
+@deftypefnx Operator {} {@B{UP}} {= (@B{l} @B{bits} a, @B{int} n) @B{l} @B{bits}}
+Dyadic operator that yields the given bits operand shifted @code{n}
+positions to the left.  Extra elements introduced on the right are
+initialized to @code{@B{false}}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{SHR}} {= (@B{l} @B{bits} a, @B{int} n) @B{l} @B{bits}}
+@deftypefnx Operator {} {@B{DOWN}} {= (@B{l} @B{bits} a, @B{int} n) @B{l} @B{bits}}
+Dyadic operator that yields the given bits operand shifted @code{n}
+positions to the right.  Extra elements introduced on the left are
+initialized to @code{@B{false}}.
+@end deftypefn
+
+@subsection Relational
+
+@deftypefn Operator {} {@B{eq}} {= (@B{l} @B{bits} a, b) @B{bool}}
+@deftypefnx Operator {} {=} {= (@B{l} @B{bits} a, b) @B{bool}}
+Dyadic operator that yields whether its operands are equal.  Two
+bits are equal if they contain the same sequence of booleans.
+@end deftypefn
+
+@deftypefn Operator {} {@B{ne}} {= (@B{l} @B{bits} a, b) @B{bool}}
+@deftypefnx Operator {} {/=} {= (@B{l} @B{bits} a, b) @B{bool}}
+Dyadic operator that yields whether its operands are not equal.
+@end deftypefn
+
+@deftypefn Operator {} {@B{lt}} {= (@B{l} @B{bits} a, b) @B{bool}}
+@deftypefnx Operator {} {<} {= (@B{l} @B{bits} a, b) @B{bool}}
+Dyadic operator that yields whether the bits @code{a} is less than
+the bits @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{le}} {= (@B{l} @B{bits} a, b) @B{bool}}
+@deftypefnx Operator {} {<=} {= (@B{l} @B{bits} a, b) @B{bool}}
+Dyadic operator that yields whether the bits @code{a} is less than,
+or equal to bits @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{gt}} {= (@B{l} @B{bits} a, b) @B{bool}}
+@deftypefnx Operator {} {>} {= (@B{l} @B{bits} a, b) @B{bool}}
+Dyadic operator that yields whether the bits @code{a} is greater than
+the bits @code{b}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{ge}} {= (@B{l} @B{bits} a, b) @B{bool}}
+@deftypefnx Operator {} {>=} {= (@B{l} @B{bits} a, b) @B{bool}}
+Dyadic operator that yields whether the bits @code{a} is greater
+than, or equal to the bits @code{b}.
+@end deftypefn
+
+@subsection Conversions
+
+@deftypefn Operator {} {@B{abs}} {= (@B{l} @B{bits} a) @B{l} @B{int}}
+Monadic operator that yields the integral value whose constituent bits
+correspond to the booleans stored in @code{a}. @xref{@code{@B{bin}}
+and @code{@B{abs}} of negative integral values}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{bin}} {= (@B{l} @B{int} a) @B{l} @B{bits}}
+Monadic operator that yields the bits value whose boolean elements map
+the bits in the given integral operand. @xref{@code{@B{bin}} and
+@code{@B{abs}} of negative integral values}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{shorten}} {= (@B{long} @B{bits} a) @B{bits}}
+@deftypefnx Operator {} {@B{shorten}} {= (@B{long} @B{long} @B{bits} a) @B{long} @B{bits}}
+Monadic operator that yields the bits value that can be lengthened to
+the value of @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{leng}} {= (@B{bits} a) @B{long} @B{bits}}
+@deftypefnx Operator {} {@B{leng}} {= (@B{long} @B{bits} a) @B{long} @B{long} @B{bits}}
+Monadic operator that yields the bits value lengthened from the value
+of @code{a}.  The lengthened value features @code{@B{false}} in the
+extra left positions added to match the lengthened size.
+@end deftypefn
+
+@node Bytes operators
+@section Bytes operators
+
+@node Semaphore operators
+@section Semaphore operators
+
+@node Math procedures
+@section Math procedures
+
+@subsection Arithmetic
+
+@deftypefn Procedure {} {@B{sqrt}} {= (@B{l} @B{real} a) @B{l} @B{real}}
+Procedure that yields the square root of the given real argument.
+@end deftypefn
+
+@subsection Logarithms
+
+@deftypefn Procedure {} {@B{ln}} {= (@B{l} @B{real} a) @B{l} @B{real}}
+Procedure that yields the base @code{e} logarithm of the given real
+argument.
+@end deftypefn
+
+@deftypefn Procedure {} {@B{exp}} {= (@B{l} @B{real} a) @B{l} @B{real}}
+Procedure that yields the exponential function of the given real
+argument.  This is the inverse of @code{@B{ln}}.
+@end deftypefn
+
+@subsection Trigonometric
+
+@deftypefn Procedure {} {@B{sin}} {= (@B{l} @B{real} a) @B{l} @B{real}}
+Procedure that yields the sin trigonometric function of the given real
+argument.
+@end deftypefn
+
+@deftypefn Procedure {} {@B{arcsin}} {= (@B{l} @B{real} a) @B{l} @B{real}}
+Procedure that yields the arc-sin trigonometric function of the given real
+argument.
+@end deftypefn
+
+@deftypefn Procedure {} {@B{cos}} {= (@B{l} @B{real} a) @B{l} @B{real}}
+Procedure that yields the cos trigonometric function of the given real
+argument.
+@end deftypefn
+
+@deftypefn Procedure {} {@B{arccos}} {= (@B{l} @B{real} a) @B{l} @B{real}}
+Procedure that yields the arc-cos trigonometric function of the given real
+argument.
+@end deftypefn
+
+@deftypefn Procedure {} {@B{tan}} {= (@B{l} @B{real} a) @B{l} @B{real}}
+Procedure that yields the tan trigonometric function of the given real
+argument.
+@end deftypefn
+
+@deftypefn Procedure {} {@B{arctan}} {= (@B{l} @B{real} a) @B{l} @B{real}}
+Procedure that yields the arc-tan trigonometric function of the given
+real argument.
+@end deftypefn
+
+@node Extended prelude
+@chapter Extended prelude
+@cindex prelude, extended
+
+This chapter documents the GNU extensions to the standard prelude.
+The facilities documented below are available to Algol 68 programs
+only if the @option{gnu68} language dialect is selected, which is the
+default.
+
+The extended prelude is available to Algol 68 programs without needing
+to import any module, provided they are compiled as @code{gnu68} code,
+which is the default.
+
+@menu
+* Extended priorities::                Priorities of extended operators.
+* Extended environment enquiries::     Information about the implementation.
+* Extended rows operators::            Rows and associated operations.
+* Extended boolean operators::         Operations on boolean operands.
+* Extended bits operators::            Bits and associated operations.
+* Extended math procedures::           Mathematical constants and functions.
+@end menu
+
+@node Extended priorities
+@section Extended priorities
+
+@table @code
+@item 3
+@itemize @bullet
+@item @code{@B{xor}}
+@end itemize
+
+@item 8
+@itemize @bullet
+@item @code{@B{elems}}
+@end itemize
+@end table
+
+@node Extended environment enquiries
+@section Extended environment enquiries
+
+An @dfn{environment enquiry} is a constant, whose value may be useful
+to the programmer, that reflects some characteristic of the particular
+implementation.  The values of these enquiries are also determined by
+the architecture and operating system targeted by the compiler.
+
+@deftypevr Constant {@B{l} @B{int}} {L min int}
+The most negative integral value.
+@end deftypevr
+
+@deftypevr Constant {@B{l} @B{real}} {L min real}
+The most negative real value.
+@end deftypevr
+
+@deftypevr Constant {@B{l} @B{real}} {L infinity}
+Positive infinity expressed in a real value.
+@end deftypevr
+
+@deftypevr Constant {@B{l} @B{real}} {L minus infinity}
+Negative infinity expressed in a real value.
+@end deftypevr
+
+@deftypevr Constant @B{char} {invalid char}
+A character that is unknown or unrepresentable in Unicode.
+@end deftypevr
+
+@node Extended rows operators
+@section Extended rows operators
+
+The following operators work on any row mode, denoted below using the
+pseudo-mode @code{@B{rows}}.
+
+@deftypefn Operator {} {@B{elems}} {= (@B{rows} a) @B{int}}
+Monadic operator that yields the number of elements implied by the
+first bound pair of the descriptor of the value of @code{a}.
+@end deftypefn
+
+@deftypefn Operator {} {@B{elems}} {= (@B{int} n, @B{rows} a) @B{int}}
+Dyadic operator that yields the number of elements implied by the n-th
+bound pair of the descriptor of the value of @code{a}.
+@end deftypefn
+
+@node Extended boolean operators
+@section Extended boolean operators
+
+@deftypefn Operator {} {@B{xor}} {= (@B{bool} a, b) @B{bool}}
+Dyadic operator that yields the exclusive-or operation of the given
+boolean arguments.
+@end deftypefn
+
+@node Extended bits operators
+@section Extended bits operators
+
+@deftypefn Operator {} {@B{xor}} {= (@B{l} @B{bits} a, b) @B{l} @B{bits}}
+Dyadic operator that yields the bit exclusive-or operation of the
+given bits arguments.
+@end deftypefn
+
+@node Extended math procedures
+@section Extended math procedures
+
+@subsection Logarithms
+
+@deftypefn Procedure {} {@B{log}} {= (@B{l} @B{real} a, b) @B{l} @B{real}}
+Procedure that calculates the base ten logarithm of the given arguments.
+@end deftypefn
+
+@node POSIX prelude
+@chapter POSIX prelude
+
+The POSIX prelude provides facilities to perform simple transput (I/O)
+based on POSIX file descriptors, accessing the file system,
+command-line arguments, environment variables, etc.
+
+This prelude is available to Algol 68 programs without needing to
+import any module, provided they are compiled as @code{gnu68} code,
+which is the default.
+
+@menu
+* POSIX process::           Process exit status.
+* POSIX command line::      Parsing command-line arguments.
+* POSIX environment::       Environment variables.
+* POSIX errors::            Error handling and error descriptions.
+* POSIX files::             Creating, opening and closing files.
+* POSIX sockets::           Communication endpoints.
+* POSIX string transput::   Reading and writing characters and strings.
+@end menu
+
+@node POSIX process
+@section POSIX process
+
+The Algol 68 program can report an exit status to the operating system
+once they stop running.  The exit status reported by default is zero,
+which corresponds to success.
+
+@deftypefn Procedure {} {set exit status} {= (@B{int} status)}
+Procedure that sets the exit status to report to the operating system
+once the program stop executing.  The default exit status is 0 which,
+by convention, is interpreted by POSIX systems as success.  A value
+different to zero is interpreted as an error status.  This procedure
+can be invoked more than one, the previous exit status being
+overwritten.
+@end deftypefn
+
+@node POSIX command line
+@section POSIX command line
+
+Algol 68 programs can access the command-line arguments passed to them
+by using the following procedures.
+
+@deftypefn Procedure {} {argc} {= @B{int}}
+Procedure that yields the number of arguments passed in the command
+line, including the name of the program.
+@end deftypefn
+
+@deftypefn Procedure {} {argv} {= (@B{int} n) @B{string}}
+Procedure that yields the @code{n}th argument passed in the command
+line.  The first argument is always the name used to invoke the
+program.  If @code{n} is out of range then this procedure returns the
+empty string.
+@end deftypefn
+
+@node POSIX environment
+@section POSIX environment
+
+@deftypefn Procedure {} {getenv} {= (@B{string} varname) @B{string}}
+Procedure that yields the value of the environment variable
+@code{varname} as a string.
+@end deftypefn
+
+@node POSIX errors
+@section POSIX errors
+
+When a call to a procedure in this prelude results in an error, the
+called procedure signals the error in some particular way and also
+sets a global @code{errno} to a code describing the error.  For
+example, trying to opening a file that doesn't exist will result in
+@code{fopen} returning -1, which signals an error.  The caller can
+then inspect the global @code{errno} to see what particular error
+prevented the operation to be completed: in this case, @code{errno}
+will contain the error code corresponding to ``file doesn't exist''.
+
+@deftypefn Procedure {} {errno} {= @B{int}}
+This procedure yields the current value of the global @code{errno}.
+The yielded value reflects the error status of the last executed POSIX
+prelude operation.
+@end deftypefn
+
+@deftypefn Procedure {} {strerror} {= (@B{int} ecode) @B{string}}
+This procedure gets an error code and yields a string containing an
+explanatory short description of the error.  It is typical to pass the
+output of @code{errno} to this procedure.
+@end deftypefn
+
+@deftypefn Procedure {} {perror} {= (@B{string} msg) @B{void}}
+This procedure prints the given string @code{msg} in the standard
+error output, followed by a colon character, a space character and
+finally the string error of the current value of @code{errno}.
+@end deftypefn
+
+@node POSIX files
+@section POSIX files
+
+File descriptors are @code{@B{int}} values that identify open files
+that can be accessed by the program.  The @code{fopen} procedure
+allocates file descriptors as it opens files, and the descriptor is
+used in subsequent transput calls to perform operations on the files.
+
+@subsection Standard file descriptors
+
+There are three descriptors, however, which are automatically opened
+when the program starts executing and automatically closed when the
+program finishes.  These are:
+
+@deftypevr Constant {@B{int}} {stdin}
+File descriptor associated with the standard input.  Its value is @code{0}.
+@end deftypevr
+
+@deftypevr Constant {@B{int}} {stdout}
+File descriptor associated with the standard output.  Its value is @code{1}.
+@end deftypevr
+
+@deftypevr Constant {@B{int}} {stderr}
+File descriptor associated with the standard error.  Its value is @code{2}.
+@end deftypevr
+
+@subsection Opening and closing files
+
+@deftypefn Procedure {} {fopen} {= (@B{string} pathname, @B{bits} flags) @B{int}}
+Open the file specified by @code{pathname}.  The argument @code{flags}
+is a combination of @code{file o} flags as defined below.  If the
+specified file is successfully opened while satisfying the constraints
+implied by @code{flags} then this procedure yields a file descriptor
+that is used in subsequent I/O calls to refer to the open
+file. Otherwise, this procedure yields -1.  The particular error can
+be inspected by calling the @code{errno} procedure.
+@end deftypefn
+
+@deftypefn Procedure {} {fclose} {= (@B{int} fd) @B{int}}
+Close the given file descriptor, which no longer refers to any file.
+This procedure yields zero on success, and -1 on error.  In the later
+case, the program can look at the particular error by calling the
+@code{errno} procedure.
+@end deftypefn
+
+@subsection Creating files
+
+@deftypefn Procedure {} {fcreate} {= (@B{string} pathname, @B{bits} mode) @B{int}}
+Create a file with name @code{pathname}.  The argument @code{mode} is
+a @code{@B{bits}} value containing a bit pattern that determines the
+permissions on the created file.  The bit pattern has the form
+@code{8rUGO}, where @code{U} reflects the permissions of the user who
+owns the file, @code{U} reflects the permissions of the users
+pertaining to the file's group, and @code{O} reflects the permissions
+of all other users.  The permission bits are 1 for execute, 2 for
+write and 4 for read.  If the file is successfully created then this
+procedure yields a file descriptor that is used in subsequent I/O
+calls to refer to the newly created file.  Otherwise, this procedure
+yields -1.  The particular error can be inspected by calling the
+@code{errno} procedure.
+@end deftypefn
+
+@subsection Flags for @code{fopen}
+
+The following flags can be combined using bit-wise operators.  Note
+that in POSIX systems the effective mode of the created file is the
+mode specified by the programmer masked with the process's
+@dfn{umask}.
+
+@deftypevr Constant {@B{bits}} {file o default}
+Flag for @code{fopen} indicating that the file shall be opened with
+whatever capabilities allowed by its permissions.
+@end deftypevr
+
+@deftypevr Constant {@B{bits}} {file o rdwr}
+Flag for @code{fopen} indicating that the file shall be opened for
+both reading and writing.
+@end deftypevr
+
+@deftypevr Constant {@B{bits}} {file o rdonly}
+Flag for @code{fopen} indicating that the file shall be opened for
+reading only.  This flag is not compatible with @code{file o rdwr} nor
+with @code{file o wronly}.
+@end deftypevr
+
+@deftypevr Constant {@B{bits}} {file o wronly}
+Flag for @code{fopen} indicating that the file shall be opened for
+write only.  This flag is not compatible with @code{file o rdwr} nor
+with @code{file o rdonly}.
+@end deftypevr
+
+@deftypevr Constant {@B{bits}} {file o trunc}
+Flag for @code{fopen} indicating that the opened file shall be
+truncated upon opening it.  The file must allow writing for this flag
+to take effect.  The effect of combining @code{file o trunc} and
+@code{file o rdonly} is undefined and varies among implementations.
+@end deftypevr
+
+@subsection Getting file properties
+
+@deftypefn Procedure {} {fsize} {= (@B{int} fd) @B{long} @B{long} @B{int}}
+Return the size in bytes of the file characterized by the file
+descriptor @code{fd}.  If the system entity characterized by the given
+file descriptor doesn't have a size, if the size of the file cannot be
+stored in a @code{@B{long} @B{long} @B{int}}, or if there is any other
+error condition, this procedure yields -1 and @code{errno} is set
+appropriately.
+@end deftypefn
+
+@node POSIX sockets
+@section POSIX sockets
+
+A program can communicate with other computers, or with other
+processes running in the same computer, via sockets.  The sockets are
+identified by file descriptors.
+
+@deftypefn Procedure {} {fconnect} {= (@B{string} host, @B{int} port) @B{int}}
+This procedure creates a stream socket and connects it to the given
+@code{host} using port @code{port}.  The established communication is
+full-duplex, and allows sending and receiving data using transput
+until it gets closed.  On success this procedure yields a file
+descriptor.  On error this procedure yields -1 and @code{errno} is set
+appropriately.
+@end deftypefn
+
+@node POSIX string transput
+@section POSIX string transput
+
+The following procedures read or write characters and strings from and
+to open files.  The external encoding of the files is assumed to be
+UTF-8.  Since Algol 68 @code{@B{char}}s are USC-4, this means that
+reading or writing a character may involve reading or writing more
+than one byte, depending on the particular Unicode code points
+involved.
+
+@subsection Output of strings and chars
+
+@deftypefn Procedure {} {putchar} {= (@B{char} c) @B{char}}
+Write the given character to the standard output.  This procedure
+yields @code{c} in case the character got successfully written, or
+@code{invalid char} otherwise.
+@end deftypefn
+
+@deftypefn Procedure {} {puts} {= (@B{string} str) @B{void}}
+Write the given string to the standard output.
+@end deftypefn
+
+@deftypefn Procedure {} {fputc} {= (@B{int} fd, @B{char} c) @B{int}}
+Write given character @code{c} to the file with descriptor @code{fd}.
+This procedure yields @code{c} on success, or @code{invalid char}
+on error.
+@end deftypefn
+
+@deftypefn Procedure {} {fputs} {= (@B{int} fd, @B{string} str) @B{int}}
+Write the given string @code{str} to the file with descriptor
+@code{fd}.  This procedure yields the number of bytes written on
+success, or 0 on error.
+@end deftypefn
+
+@subsection Input of strings and chars
+
+@deftypefn Procedure {} {getchar} {= @B{char}}
+Read a character from the standard input.  This procedure yields the
+read character in case the character got successfully read, or
+@code{invalid char} otherwise.
+@end deftypefn
+
+@deftypefn Procedure {} {gets} {= (@B{int} n) @B{ref} @B{string}}
+Read a string composed of @code{n} characters from the standard input
+and yield a reference to it.  If @code{n} is bigger than zero then
+characters get read until either @code{n} characters have been read or
+the end of line is reached.  If @code{n} is zero or negative then
+characters get read until either a new line character is read or the
+end of line is reached.
+@end deftypefn
+
+@deftypefn Procedure {} {fgetc} {= (@B{int} fd) @B{int}}
+Read a character from the file with descriptor @code{fd}.  This
+procedure yields the read character in case the character got
+successfully read, or @code{invalid char} otherwise.
+@end deftypefn
+
+@deftypefn Procedure {} {fgets} {= (@B{int} fd, @B{int} n) @B{ref} @B{string}}
+Read a string from the file with descriptor @code{fd} and yield a
+reference to it.  If @code{n} is bigger than zero then characters get
+read until either @code{n} characters have been read or the end of
+line is reached.  If @code{n} is zero or negative then characters get
+read until either a new line character is read or the end of line is
+reached.
+@end deftypefn
+
+@node Language extensions
+@chapter Language extensions
+
+This chapter documents the GNU extensions implemented by this compiler
+on top of the Algol 68 programming language.  These extensions
+collectively conform a strict @dfn{superlanguage} of Algol 68, and are
+enabled by default.  To disable them the user can select the strict
+Algol 68 standard by passing the option @option{-std=algol68} when
+invoking the compiler.
+
+@menu
+* @code{@B{bin}} and @code{@B{abs}} of negative integral values::
+* Bold taggles::              Using underscores in mode and operator indications.
+@end menu
+
+@node @code{@B{bin}} and @code{@B{abs}} of negative integral values
+@section @code{@B{bin}} and @code{@B{abs}} of negative integral values
+
+The @code{@B{bin}} operator gets an integral value and yields a
+@code{@B{bits}} value that reflects the internal bits of the integral
+value.  The semantics of this operator, as defined in the Algol 68
+standard prelude, are:
+
+@example
+@B{op} @B{bin} = (L @B{int} a) L @B{bits}:
+  @B{if} a >= L 0
+  @B{then} L @B{int} b := a; L @B{bits};
+       @B{for} i @B{from} L bits width @B{by} -1 @B{to} 1
+       @B{do} (L F @B{of} c)[i] := @B{odd} b; b := b % L 2 @B{od};
+       c
+  @B{fi};
+@end example
+
+The @code{@B{abs}} operator performs the inverse operation of
+@code{@B{bits}}.  Given a @code{L @B{bits}} value, it yields the
+@code{L @B{int}} value whose bits representation is the bits value.
+The semantics of this operator, as defined in the Algol 68 prelude,
+are:
+
+@example
+@B{op} @B{abs} = (L @B{bits} a) L @B{int}:
+@B{begin} L @B{int} c := L 0;
+      @B{for} i @B{to} L bits width
+      @B{do} c := L 2 * c + K @B{abs} (L F @B{of} a)[i] @B{od};
+      c
+@B{end}
+@end example
+
+@noindent
+Note how the @code{@B{bin}} of a negative integral value is not
+defined: the implicit else-part of the conditional yields
+@code{@B{skip}}, which is defined as any bits value in that context.
+Note also how @code{@B{abs}} doesn't make any provision to check
+whether the resulting value is positive: it assumes it is so.
+
+The GNU Algol 68 compiler, when working in strict Algol 68 mode
+(@option{-std=algol68}), makes @code{@B{bin}} to always yield @code{L
+@B{bits} (@B{skip})} when given a negative value, as mandated by the
+report.  But the skip value is always the bits representation of zero,
+@i{i.e.} 2r0.  Strict Algol 68 programs, however, must not rely on
+this.
+
+When GNU extensions are enabled (@option{-std=gnu68}) the
+@code{@B{bin}} of a negative value yields the two's complement bit
+pattern of the value rather than zero.  Therefore, @code{@B{bin} -
+@B{short} @B{short} 2} yields @code{2r11111110}.  And @code{@B{abs}
+@B{short} @B{short} 2r11111110} yields -2.
+
+@node Bold taggles
+@section Bold taggles
+
+This compiler supports the stropping regimes known as UPPER and
+SUPPER.  In both regimes bold words are written by writing their
+constituent bold letters and digits, in order.  In UPPER regime all
+the letters of a bold word are to be written using upper-case.  In
+SUPPER regime, only the first bold letter is required to be written
+using upper-case, and this only when the bold word is not a reserved
+word.
+
+When a bold word comprises several natural words, it may be a little
+difficult to distinguish them at first sight.  Consider for example
+the following code, written fist in UPPER stropping:
+
+@example
+MODE TREENODE = STRUCT (TREENODEPAYLOAD data, REF TREENODE next),
+     TREENODEPAYLOAD = STRUCT (INT code, REAL average, mean);
+@end example
+
+@noindent
+Then written in SUPPER stropping:
+
+@example
+mode TreeNode = struct (TreeNodePayload data, REF TreeNode next),
+     TreeNodePayload = struct (int code, real average, mean);
+@end example
+
+Particularly in UPPER stropping, it may be difficult to distinguish
+the constituent natural words at first sight.
+
+In order to improve this, this compiler implements a GNU extension
+called @dfn{bold taggles} that allows to use underscore characters
+(@code{_}) within mode and operator indications as a visual aid to
+improve readability.  When this extension is enabled, mode indications
+and operator indications consist in a sequence of the so-called
+@dfn{bold taggles}, which are themselves sequences of one or more bold
+letters or digits optionally terminated by an underscore character.
+
+With bold taggles enabled the program above could have been written
+using UPPER stropping as:
+
+@example
+MODE TREE_NODE = STRUCT (TREE_NODE_PAYLOAD data, REF TREE_NODE next),
+     TREE_NODE_PAYLOAD = STRUCT (INT code, REAL average, mean);
+@end example
+
+@noindent
+And using SUPPER stropping as:
+
+@example
+mode Tree_Node = struct (Tree_Node_Payload data, ref Tree_Node next),
+     Tree_Node_Payload = struct (int code, real average, mean);
+@end example
+
+@noindent
+Which is perhaps more readable for most people.  Note that the
+underscore characters are not really part of the mode or operator
+indication.  Both @code{TREE_NODE} and @code{TREENODE} denote the same
+mode indication.  Note also that, following the definition, constructs
+like @code{Foo__bar} and @code{_Baz} are not valid indications.
+
+Bold taggles are available when the gnu68 dialect of the language is
+selected.  @xref{Dialect options}.
+
+@include gpl_v3.texi
+@include fdl.texi
+
+@node Option Index
+@unnumbered Option Index
+
+@command{ga68}'s command line options are indexed here without any initial
+@samp{-} or @samp{--}.  Where an option has both positive and negative forms
+(such as @option{-f@var{option}} and @option{-fno-@var{option}}), relevant
+entries in the manual are indexed under the most appropriate form; it may
+sometimes be useful to look up both forms.
+
+@printindex op
+
+@node General Index
+@unnumbered Index
+
+@printindex cp
+
+@bye
--- /dev/null
+++ b/src/gcc/algol68/ga68.vw
@@ -0,0 +1,1837 @@
+{ ga68.vw - The GNU Algol 68 strict language -*- vw -*-
+
+  Copyright (C) 2025 Jose E. Marchesi <jemarch@gnu.org>
+
+  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, 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.  }
+
+{ This file contains an annotated description of the syntax of the GNU
+  Algol 68 strict language.  GNU Algol 68 aims to be a super-language
+  of Algol 68.
+
+  Extension to the strict Revised Report incorporated into GNU Algol
+  68 are:
+
+  [US] This is the GNU68-2025-001-unsafe GNU extension.  It adds an
+       unsafe clause that marks a controlled clause as containing
+       unsafe constructs which are known by the programmer, and makes
+       the compiler to avoid certain diagnostics.  See the GNU Algol
+       68 Compiler manual for more information.
+
+  [SC] This is the GNU68-2025-003-andth-orel GNU extension.  It adds
+       two units that act as pseudo-operators providing logical AND
+       and OR functions with short-circuited elaboration.  See the GNU
+       Algol 68 Compiler manual for more information.
+
+  [MR] A modules and separated compilation system based on the modules
+       system recomended by IFIP Working Group 2.1 Standing
+       Subcommittee on Algol 68 Support, described in:
+
+         A Modules and Separate Compilation Facility for Algol 68 by
+         Lindsey and Boom.
+
+  [NC] This is the GNU68-2025-005-nestable-comments GNU extension.  It
+       adds support for nestable block comments.
+
+  The metaproduction rules, hyper-rules and hyper-alternatives
+  introduced by each extension are clearly marked in the sections
+  below.  You can easily search for them using the extensions tags in
+  the list above.  For example, to look for the extensions introduced
+  by the modules and separated compilation system, search for [MR].
+
+  The few deviations to the RR Algol 68 are clearly marked as well in
+  this specification.
+
+  A complete description of the semantics of the Algol 68 subset of
+  the described language and the extensions is not included in this
+  file.  The reader is referred to the Revised Report and other
+  documentation corresponding to the extensions, like the GNU Algol 68
+  compiler manual.
+
+  The sectioning and the enumeration of metaproduction rules and of
+  hyper-rules, including cross-references, are the same than in the
+  Report.  The annotations and pragmatics added between curly brackets
+  explain the meaning of the rules and how they describe the syntax of
+  the language.  Note that thanks to the expressive power of VW
+  grammars the syntax expressed by this description covers much more
+  than what is usually expressed by context-free grammars in the
+  descriptions of other languages that typically use some variant of
+  the BNF notation.
+
+  Sample code in examples and pragmatics is expressed using the UPPER
+  stropping regime.
+
+  This file is better browsed using the Emacs vw-mode, which provides
+  automatic indentation, font-lock, and other facilities like the
+  hiding of annotations an the following of cross-references.  See the
+  vw-mode manual for more information, including a primer on VW
+  grammars and the formal description used in both the original Report
+  and this file.  }
+
+1 Language and metalanguage
+
+1.2 General metaproduction rules
+
+1.2.1 Metaproduction rules of modes
+
+A) MODE :: PLAIN ; STOWED ; REF to MODE ; PROCEDURE ;
+           UNITED ; MU definition of MODE ; MU application.
+B) PLAIN :: INTREAL ; boolean ; character.
+C) INTREAL :: SIZETY integral ; SIZETY real.
+D) SIZETY :: long LONGSETY ; short SHORTSETY ; EMPTY.
+E) LONGSETY :: long LONGSETY ; EMPTY.
+F) SHORTSETY :: short SHORTSETY ; EMPTY.
+G) EMPTY :: .
+H) STOWED :: structured with FIELDS mode ;
+             FLEXETY ROWS of MODE.
+I) FIELDS :: FIELD ; FIELDS FIELD.
+J) FIELD :: MODE field TAG{942A}.
+K) FLEXETY :: flexible ; EMPTY.
+L) ROWS :: row ; ROWS row.
+M) REF :: reference ; transient reference.
+N) PROCEDURE :: procedure PARAMETY yielding MOID.
+O) PARAMETY :: with PARAMETERS ; EMPTY.
+P) PARAMETERS :: PARAMETER ; PARAMETERS PARAMETER.
+Q) PARAMETER :: MODE parameter.
+R) MOID :: MODE ; void.
+S) UNITED :: union of MOODS mode.
+T) MOODS :: MOOD ; MOODS MOOD.
+U) MOOD :: PLAIN ; STOWED ; reference to MODE ; PROCEDURE ; void.
+V) MU :: muTALLY.
+W) TALLY :: i ; TALLY i.
+
+1.2.2 Metaproduction rules associated with phrases and coercion
+
+{ Extensions:
+  [MR] access
+  [US] unsafe }
+
+A) ENCLOSED :: closed ; collateral ; parallel ; CHOICE{34A} ;
+               loop ; access ; unsafe.
+B) SOME :: SORT MOID NEST.
+C) SORT :: strong ; firm ; meek ; weak ; soft.
+
+{ Modules are activated by means of access-clauses.  }
+
+1.2.3 Metaproduction rules associated with nests
+
+{ Extensions:
+  [MR] MODSETY, MOD, MODS, REVSETY, REVS, REV,
+       TAU, INKSETY, INKS, INK }
+
+A) NEST :: LAYER ; NEST LAYER.
+B) LAYER :: new DECSETY LABSETY INKSETY.
+C) DECSETY :: DECS ; EMPTY.
+D) DECS :: DEC ; DECS DEC.
+E) DEC :: MODE TAG{942A} ; priority PRIO TAD{942F} ;
+          MOID TALLY TAB{942D} ; DUO TAD{942F}  MONO TAM{492K} ;
+          MOD.
+F) PRIO :: i ; ii ; iii ;
+           iii i ; iii ii ; iii iii ;
+           iii iii i ; iii iii ii ; iii iii iii.
+G) MONO :: procedure with PARAMETER yielding MOID.
+H) DUO :: procedure with PARAMETER1 PARAMETER2 yielding MOID.
+I) LABSETY :: LABS ; EMPTY.
+J) LABS :: LAB ; LABS LAB.
+K) LAB :: label TAG{942A}.
+L) MODSETY :: MODS ; EMPTY.
+M) MODS :: MOD ; MODS MOD.
+N) MOD :: module REVS TAB.
+O) REVSETY :: REVS ; EMPTY.
+P) REVS :: REV ; REVS REV.
+Q) REV :: TAU reveals DECSETY INKS.
+R) TAU :: MU.
+S) INKSETY :: INKS ; EMPTY.
+T) INKS :: INK ; INKS INK.
+U) INK :: invoked TAU.
+
+{ The primal environment is just 'new'. }
+
+1.3 General hyper-rules
+
+1.3.1 Syntax of general predicates
+
+A) NOTION :: ALPHA ; NOTION ALPHA.
+B) ALPHA :: 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.
+C) NOTETY :: NOTION ; EMPTY.
+D) THING :: NOTION ;
+            (NOTETY1) NOTETY2 ;
+            THING (NOTETY1) NOTETY2.
+E) WHETHER :: where ; unless.
+
+a) where true : EMPTY.
+b) unless false : EMPTY.
+c) where THING1 and THING2 : where THING1, where THING2.
+d) where THING1 or THING2 : where THING1 ; where THING2.
+e) unless THING1 and THING2 : unless THING1; unless THING2.
+f) unless THING1 or THING2 : unless THING1, unless THING2.
+g) WHETHER (NOTETY1) is (NOTETY2) :
+     WHETHER (NOTETY1) begins with (NOTETY2){h,i,j}
+             and (NOTETY2) begins with (NOTETY1){h,i,j}.
+h) WHETHER (EMPTY) begins with (NOTION){g,j} :
+     WHETHER false{b,-}.
+i) WHETHER (NOTETY1) begins with (EMPTY){g,j} :
+     WHETHER true{a,-}.
+j) WHETHER (ALPHA1 NOTETY1) begins with
+           (ALPHA2 NOTETY2){g,j,m} :
+     WHETHER (ALPHA1) coincides with (ALPHA2) in
+             (abcdefghijklmnopqrstuvwxyz){k,l,-}
+             and (NOTETY1) begins with (NOTETY2){h,i,j}.
+k) where (ALPHA) coincides with (ALPHA) in (NOTION){j} :
+     where true{a}.
+l) unless (ALPHA1) coincides with (ALPHA2) in (NOTION){j} :
+     where (NOTION) contains (ALPHA1 NOTETY ALPHA2){m}
+           or (NOTION) contains (ALPHA2 NOTETY ALPHA1){m}.
+m) WHETHER (ALPHA NOTETY) contains (NOTION){l,m} :
+     WHETHER (ALPHA NOTETY) begins with (NOTION){j}
+             or (NOTETY) contains (NOTION){m,n}.
+n) WHETHER (EMPTY) contains (NOTION){m} : WHETHER false{b,-}.
+
+1.3.3 Syntax of general constructions
+
+A) STYLE :: brief ; bold ; style TALLY.
+
+a) NOTION option : NOTION ; EMPTY.
+b) NOTION sequence{b} : NOTION ; NOTION, NOTION sequence{b}.
+c) NOTION list{c} :
+     NOTION ; NOTION, and also{94f} token, NOTION list{c}.
+d) NOTETY STYLE pack :
+     STYLE begin{94f,-} token, NOTETY, STYLE end{94f,-} token.
+e) NOTION STYLE bracket :
+     STYLE sub{94f,-} token, NOTION, STYLE bus{94f,-} token.
+f) THING1 or alternatively THING2 : THING1 ; THING2.
+
+2 The computer and the program
+
+2.2 The program
+
+2.2.1 Syntax
+
+a) program : program token, strong integral new closed clause{31a}.
+
+{ The value yielded by the elaboration of the program is the exit
+  status returned by the process to the operating system upon
+  termination.  This is a slight deviation from the Report, which
+  instead specifies:
+
+  a) program : strong void new closed clause.
+
+  and mandates that the production tree of a particular program should
+  be akin to the production of the program in the strict language. }
+
+3 Clauses
+
+3.0.1 Syntax
+
+{ Extensions:
+  [MR] "NEST module text publishing REVS defining LAYER",
+       "NEST LAYER1 LAYER2 module series with DECSETY
+          without DECSETY",
+       "SOID NEST access clause"  }
+
+a) *phrase : SOME unit{32d} ; NEST declaration of DECS{41a}.
+b) *SORT MODE expression : SORT MODE NEST UNIT{5A}.
+c) *statement : strong void NEST UNIT{5A}.
+d) *MOID constant : MOID NEST DEFIED identifier with TAG{48a,b} ;
+                    MOID NEST denoter{80a}.
+e) *MODE variable :
+     reference to MODE NEST DEFIED identifier with TAG{48a,b}.
+f) *NEST range :
+     SOID NEST serial clause defining LAYER{32a} ;
+     SOID NEST chooser CHOICE STYLE clause{34b} ;
+     SOID NEST case part of choice using UNITED{34i} ;
+     NEST STYLE repeating part with DEC{35e} ;
+     NEST STYLE while do part{35f} ;
+     PROCEDURE NEST routine text{541a,b} ;
+     NEST module text publishing REVS defining LAYER{49c,-} ;
+     NEST LAYER1 LAYER2 module series
+          with DECSETY without DECSETY1{49d} ;
+     SOID NEST access clause{36a}.
+
+{ The rules b and c establish a precise definition of "expressions"
+  and "statements".  The former are units yielding values of a mode
+  other than VOID in any context.  The later are units in a strong
+  context with a-posteriori mode of VOID, that get voided. }
+
+{ The rules d and e establish a precise definition of "constants" and
+  "variables".  The former are either a denotation or an identifier of
+  some mode.  The second are identifiers of a "reference to" mode. }
+
+{ The rule f introduces a paranotion for all the constructs that
+  introduce new ranges.  }
+
+3.1 Closed clauses
+
+3.1.1 Syntax
+
+A) SOID :: SORT MOID.
+B) PACK :: STYLE pack.
+
+a) SOID NEST closed clause{22a,5D,551a,A341h,A349a} :
+     SOID NEST serial clause defining LAYER{32a} PACK.
+
+{ Examples:
+  a) BEGIN x := 1; y := 2 END }
+
+3.2 Serial clauses
+
+3.2.1 Syntax
+
+{ Extensions:
+  [MR] "establishing clause"  }
+
+a) SOID NEST serial clause defining new PROPSETY{31a,34f,1,35h} :
+     SOID NEST new PROPSETY series with PROPSETY{b}.
+b) SOID NEST series with PROPSETY{a,b,35c} :
+     strong void NEST unit{d}, go on{94f} token,
+       SOID NEST series with PROPSETY{b} ;
+     where (PROPSETY) is (DECS DECSETY LABSETY),
+       NEST declaration of DECS{41a}, go on{94f} token,
+       SOID NEST series with DECSETY LABSETY{b} ;
+     where (PROPSETY) is (LAB LABSETY),
+       NEST label definition of LAB{c},
+       SOID NEST series with LABSETY{b} ;
+     where (PROPSETY) is (LAB LABSETY)
+           and SOID balances SOID1 and SOID2{3}, SOID1 NEST unit{d},
+       completion{94f} token, NEST label definition of LAB{c},
+       SOID2 NEST series with LABSETY{b} ;
+     where (PROPSETY) is (EMPTY),
+       SOID NEST unit{d}.
+c) NEST label definition of label TAG{b} :
+     label NEST defining identifier with TAG{48a}, label{94f} token.
+d) SOME unit{b,33b,g,34i,35d,46m,n,521c,532e,541a,b,543c,A34Ab,c,d} :
+     SOME UNIT{5A,-}.
+e) WHETHER SORT MOID balances
+           SORT1 MOID1 an SORT2 MOID2{b,33b,34d,h} :
+     WHETHER SORT balances SORT1 and SORT2{f}
+             and MOID balances MOID1 and MOID2{g}.
+f) WHETHER SORT balances SORT1 and SORT2{e,522a} :
+     where (SORT1) is (strong), WHETHER (SORT2) is (SORT) ;
+     where (SORT2) is (strong), WHETHER (SORT1) is (SORT).
+g) WHETHER MOID balances MOID1 and MOID2{3} :
+     where (MOID1) is (MOID2), WHETHER (MOID) is (MOID1) ;
+     where (MOID1) is (transient MOID2),
+       WHETHER (MOID) is (MOID1) ;
+     where (MOID2) is (transient MOID1),
+       WHETHER (MOID) is (MOID2).
+
+h) *SOID unitary clause : SOID NEST unit{d}.
+i) *establishing clause :
+     SOID NEST serial clause defining LAYER{32a} ;
+     MODE NEST enquiry clause defining LAYER{34c}.
+
+{ The paranotion establishing-clause encompasses both module-texts and
+  revelations.  }
+
+{ Examples:
+  b) read (x1); REAL s:= 0;
+     sum: FOR i TO n DO (x1[i] > 0 | s :+= x1[i] | nonpos) OD EXIT
+     nonpos: print (s)
+
+     REAL s := 0;
+     sum: FOR i TO n DO (x1[i] > 0 | s :+= x1[i] | nonpos) OD EXIT
+     nonpos: print (s)
+
+     sum: FOR i TO n DO (x1[i] > 0 | s :+= x1[i] | nonpos) OD EXIT
+     nonpos: print (s)
+
+     FOR i TO n DO (x1[i] > 0 | s :+= x1[i] | nonpos) OD EXIT
+     nonpos: print (s)
+  c) sum:
+  d) print (s) }
+
+3.3 Collateral and parallel clauses
+
+3.3.1 Syntax
+
+a) strong void NEST collateral clause{5D,551a} :
+     strong void NEST joined portrait{b} PACK.
+b) SOID NEST joined portrait{a,b,c,d,34g} :
+     were SOID balances SOID1 and SOID2{32e},
+       SOID1 NEST unit{32d}, and also{94f} token,
+       SOID2 NEST unit{32d}
+             or alternatively SOID2 NEST joined portrait{b}.
+c) strong void NEST parallel clause{5D,551a} :
+     parallel{94f} token, strong void NEST joined portrait{b} PACK.
+d) strong ROWS of MODE NEST collateral clause{5D,551a} :
+     where (ROWS) is (row),
+       strong MODE NEST joined portrait{b} PACK ;
+     where (ROWS) is (row ROWS1),
+       strong ROWS1 of MODE NEST joined portrait{b} PACK ;
+     EMPTY PACK.
+e) strong structured with
+          FIELDS FIELD mode NEST collateral clause{5D,551a} :
+     NEST FIELDS FIELD portrait{f} PACK.
+f) NEST FIELDS FIELD portrait{3,f} :
+     NEST FIELDS portrait{f,g}, an also{94f} token,
+       NEST FIELD portrait{g}.
+g) NEST MODE field TAG portrait{f} : strong MODE NEST unit{32d}.
+
+h) *structure display :
+     strong structured with FIELDS FIELD mode NEST collateral clause{e}.
+i) *row display :
+     strong ROWS of MODE NEST collateral clause{d}.
+j) *display : strong STOWED NEST collateral clause{d,e}.
+k) *vacuum : EMPTY PACK.
+
+3.4 Choice clauses
+
+3.4.1 Syntax
+
+A) CHOICE :: choice using boolean ; CASE.
+B) CASE :: choice using intgral ; choice using UNITED.
+
+a) SOID NEST1 CHOICE clause{5D,551a,A341h,A349a} :
+     CHOICE STYLE start{91a,-},
+       SOID NEST1 chooser CHOICE STYLE clause{b},
+       CHOICE STYLE finish{91e,-}.
+b) SOID NEST1 chooser choice using MODE STYLE clause{a,l} :
+     MODE NEST1 enquiry clause defining LAYER2{c,-},
+       SOID NEST1 LAYER2 alternate choice using MODE STYLE clause{d}.
+c) MODE NEST1 enquiry clause defining new DECSETY2{b,35g} :
+     meek MODE NEST1 new DESETY2 series with DECSETY2{32b}.
+d) SOID NEST2 alternate CHOICE STYLE clause{b} :
+     SOID NEST2 in CHOICE STYLE clause{e} ;
+     where SOID balances SOID1 and SOID2{32e},
+       SOID1 NEST2 in CHOICE STYLE clause{3},
+       SOID2 NEST2 out CHOICE STYLE clause{l}.
+e) SOID NEST2 in CHOICE STYLE clause{d} :
+     CHOICE STYLE in{91b,-}, SOID NEST2 in part of CHOICE{f,g,h}.
+f) SOID NEST2 in part of choice using boolean{e} :
+     SOID NEST2 serial clause defining LAYER3{32a}.
+g) SOID NEST2 in part of choice using integral{e} :
+     SOID NEST2 joined portrait{33b}.
+h) SOID NEST2 in part of choice using UNITED{e,h} :
+     SOID NEST2 case part of choice using UNITED{i} ;
+     where SOID balances SOID1 and SOID2{32e},
+       SOID1 NEST2 case part of choice using UNITED{i},
+       and also{94f} token,
+       SOID2 NEST2 in part of choice using UNITED{h}.
+i) SOID NEST2 case part of choice using UNITED{h} :
+     MOID NEST2 LAYER3 specification defining LAYER3{jk,-},
+       where MOID unites to UNITED{64b},
+       SOID NEST2 LAYER3 unit{32d}.
+j) MODE NEST3 specification defining new MODE TAG3{i} :
+     NEST3 declarative defining new MODE TAG3{541e} brief pack,
+       colon{94f} token.
+k) MOID NEST3 specification defining new EMPTY{i} :
+     formal MOID NEST3 declarer{46b} brief pack, colon{94f} token.
+l) SOID NEST2 out CHOICE STYLE clause{d} :
+     CHOICE STYLE out{91d,-},
+       SOID NEST2 serial lause defining LAYER3{32a} ;
+     CHOICE STYLE again{91c,-},
+       SOID NEST2 chooser CHOICE2 STYLE clause{b},
+       where CHOICE2 may follow CHOICE{m}.
+m) WHETHER choice using MODE2 may follow choice using MODE1{l} :
+     where (MODE1) is (MOOD), WHETHER (MODE2) is (MODE1) ;
+     where (MODE1) begins with (union of),
+       WHETHER (MODE2) begins with (union of).
+
+n) *SOME choice clause : SOME CHOICE clause{a}.
+o) *SOME conditional clause : SOME choice using boolean clause{a}.
+p) *SOME case clause : SOME choice using integral clause{a}.
+q) *SOME conformity clause : SOME choice using UNITED clause{a}.
+
+3.5 Loop clauses
+
+3.5.1 Syntax
+
+A) FROBYT :: from ; by ; to.
+
+a) strong void NEST1 loop clause{5D,551a} :
+     NEST1 STYLE for part defining new integral TAG2{b},
+       NEST1 STYLE intervals{c},
+       NEST1 STYLE repeating part with integral TAG2{e}.
+b) NEST1 STYLE for part defining new integral TAG2{a} :
+     STYLE for{94g,-} token,
+       integral NEST1 new integral TAG2 defining identifier
+                with TAG2{48a} ;
+     where (TAG2) is (letter aleph), EMPTY.
+c) NEST1 STYLE intervals{a} :
+     NEST1 STYLE from part{d} option,
+       NEST1 STYLE by part{d} option,
+       NEST1 STYLE to part{d} option.
+d) NEST1 STYLE FROBYT part{c} :
+     STYLE FROBYT{94g,-} token, meek integral NEST1 unit{32d}.
+e) NEST1 STYLE repeating part with DEC2{a} :
+     NEST1 new DEC2 STYLE while do part{f} ;
+     NEST1 new DEC2 STYLE do part{h}.
+f) NEST2 STYLE while do part{e} :
+     NEST2 STYLE while part defining LAYER3{g},
+       NEST2 LAYER3 STYLE do part{h}.
+g) NEST2 STYLE while part defining LAYER3{f} :
+     STYLE while{94g,-} token,
+       boolean NEST2 enquiry clause defining LAYER3{34c,-}.
+h) NEST3 STYLE do part{3,f} :
+     STYLE do{94g,-} token,
+       strong void NEST3 serial clause defining LAYER4{32a},
+       STYLE od{94g,-} token.
+
+3.6 Access clauses
+
+{ Extensions:
+  [MR] GMR }
+
+{ Access clauses contain a controlled-clause, which is an
+  enclosed-clause. }
+
+3.6.1 Syntax
+
+a) SOID NEST access clause{5D,551a,A341h,A349a} :
+     NEST revelation publishing EMPTY defining LAYER{b},
+       SOID NEST LAYER ENCLOSED clause{a,31a,33a,c,d,e,34a,35a,-}.
+b) NEST revelation publishing REVSETY
+        defining new DECSETY INKSETY{a,49c} :
+     access{94d} token,
+       NEST joined module call publishing REVSETY revealing REVS{c},
+       where DECSETY INKS revealed by REVS{e,f}
+             and NEST filters INKSETY out of INKS{h}.
+c) NEST joined module call publishing REVSETY revealing RES{b,c} :
+     NEST moule call publishing REVSETY revealing REVS{d,-} ;
+     where (REVSETY) is (REVSETY1 REVSETY2)
+           an (REVS) is (REVS1 REVS2),
+       NEST module call publishing REVSETY1 revealing REVS1{d,-},
+       and also{94f} token,
+       NEST joined module call publishing REVSETY2 revealing REVS2{c}.
+d) NEST module call publishing REVSETY revealing REVS{c} :
+     where (REVSETY) is (EMPTY),
+       module REVS NEST applied module indication with TAB{48b} ;
+     where (REVSETY) is (REVS),
+       public{94d} token,
+       module REVS NEST applied module indication with TAB{48b}.
+e) WHETHER DECSETY1 DECSETY2 INKS1 INKSETY2 revealed by
+           TAU reveals DECSETY1 INKS1 REVSETY3
+           TAU reveals DECSETY1 INKS1 REVSETY4{b,e,f} :
+     WHETHER DECSETY DECSETY2 INKS1 INKSETY2 revealed by
+             TAU reveals DECSETY1 INKS1 REVSETY3 REVSETY4{e,f}.
+f) WHETHER DECSETY1 DECSETY2 INKS1 INKSETY2 revealed by
+           TAU reveals DECSETY1 INKS1 REVSETY2{b,e,f} :
+     WHETHER DECSETY2 INKSETY2 revealed by REVSETY2
+             and DECSETY1 independent DECSETY2{71a,b,c}.
+g) WHETHER EMPTY revealed by EmPTY{e,f} : WHETHER true.
+h) WHETHER NEST filters INKSETY1 out of INKSETY INK{b} :
+     unless INK ientified in NEST{72a},
+       WHETHER (INKSETY) is (INKSETY2 INK)
+               and NEST INK filers INKSETY2 out of INKSETY{h,i} ;
+     where INK identified in NEST{72a},
+       WHETHER NEST filters INKSETY1 out of INKSETY{h,i}.
+i) WHETHER NEST filters EMPTY out of EMPTY{h} : WHETHER true.
+
+{ Examples:
+    a) ACCESS A, B (gets (f, a); puts (a))
+    b) ACCESS A, B
+    c) A, B
+    d) A
+       PUB B  }
+
+{ In rule b, the 'invoke TAU's enveloped by 'INKS' represent those
+  modules which might need to be invoked at any module-call whose
+  applied-module-indication identified a particular
+  defining-module-indication, whereas those enveloped by 'INKSETY'
+  represent only those which need invocation in the particular
+  context, the remainder having already being elaborated, as can be
+  determined statically from the 'NEST'.  The presence of 'INKSETY' in
+  the nest of all descendent constructs of the access-clause ensures
+  that all modules now invoked will never be invoked again within
+  those descendents.  }
+
+{ Rule f ensures the independence of declarations revealed by one
+  revelation; thus
+
+    MODULE A = DEF PUB REAL x FED, B = DEF PUB REAL x FED;
+    ACCESS A, B (x)
+
+  is not produced.  However, rule e allows a given declaration to be
+  revealed by two public accesses of the same module, as in
+
+    MODULE A = DEF PUB REAL x FED;
+    MODULE B = ACCESS PUB A DEF REAL y FED,
+           C = ACCESS PUB A DEF REAL z FED;
+    ACCESS B C (x + y + z)
+
+  in which the module-definitions for both B and C reveal x, by virtue
+  of the PUB A in their constituent revelations.  }
+
+{ Note that a particular-program may now consist of a
+  joined-label-definition followed by an access-clause.  The
+  defining-module- indications identified thereby would be in the
+  library-prelude or the user-prelude.  }
+
+3.7 Unsafe clauses
+
+{ Extensions: [US] }
+
+{ Unsafe clauses contain a controlled-clause, which is an enclosed-clause. }
+
+3.7.1 Syntax
+
+a) SOID NEST unsafe clause :
+     unsafe{94f} token, SOID NEST ENCLOSED clause{a,31a,33a,c,d,e,34a,35a,-}.
+
+{ Examples:
+    a) UNSAFE (ptr := dst)  }
+
+4 Declarations, declarers and indicators
+
+4.1 Declarations
+
+4.1.1 Syntax
+
+{ Extensions:
+  [MR] module
+       "declaration with DECSETY without DECSETY1" }
+
+A) COMMON :: mode ; priority ; MODINE identity ;
+             reference to MODINE variable ; MODINE operation ;
+             PARAMETER ; MODE FIELDS ; module.
+             { MODINE :: MODE ; routine. }
+
+a) NEST declaration of DECS{a,32b} :
+     NEST COMMON declaration of DECS{42a,43a,44a,e,45a,-} ;
+     where (DECS) is (DECS1 DECS2),
+       NEST COMMON declaration of DECS1{42a,43a,44a,e,45a,-},
+       and also{94f} token, NEST declaration of DECS2{a}.
+b) NEST COMMON joined definition of PROPS PROP{b,42a,43a,44a,e,45a,46e,541e} :
+     NEST COMON joined definition of PROPS{b,c},
+       and also{94f} token,
+       NEST COMMON joined definition of PROP{c}.
+c) NEST COMMON joined definition of PROP{b,42a,43a,44a,e,45a,46e,541e} :
+     NEST COMMON definition of PROP{42b,43b,44c,f,45c,46f,541f,-}.
+
+d) *definition of PROP :
+     NEST COMMON definition of PROP{42b,43b,44c,f,45c,46f,541f} ;
+     NEST label definition of PROP{32}.
+e) NEST declaration with DECSETY without DECSETY1{49e} :
+     where (DECSETY without DECSETY1) is (EMPTY without DECS1),
+       NEST COMMON declaration of DECS1{42a,43a,44a,e,45a,49a,-} ;
+     where (DECSETY without DECSETY1) is (DECS without EMPTY),
+       public{94d} token,
+       NEST COMMON declaration of DECS{42a,43a,44a,e,45a,49a,-} ;
+     where (DECSETY without DECSETY1) is
+           (DECSETY without DECS1 DECSETY2),
+       NEST COMMON declaration of DECS1{42a,43a,44a,e,45a,49a,-},
+       and also{94f} token,
+       NEST declaration with DECSETY without DECSETY2{e} ;
+     where (DECSETY without DECSETY1) is
+           (DECS DECSETY3 without DECSETY1),
+       public{94d} token,
+       NEST COMMON declaration of DECS{42a,43a,44a,e,45a,49a,-},
+       and also{94f} token,
+       NEST declaration with DECSETY3 without DECSETY1{e}.
+
+{ Rule e determines how a "NEST declaration with DECSETY without
+  DECSETY1" results into two groups of declarations.  The declarations
+  in 'DECSETY' are public and syntactically preceded by PUB.  The
+  declarations in 'DECSETY1 are non-public and are not marked by
+  PUB.  }
+
+4.2 Mode declarations
+
+4.2.1 Syntax
+
+a) NEST mode declaration of DECS{41a} :
+     mode{94d} token, NEST mode joined definition of DECS{41b,c}.
+b) NEST mode definition of MOID TALLY TAB{41c} :
+     where (TAB) is (bold TAG) or (NEST) is (new LAYER),
+       MOID TALLY NEST defining mode indication with TAB{48a},
+       is defined as{94d} token,
+       actual MOI TALLY NEST declarer{c}.
+c) actual MOID TALLY1 NEST declarer{b} :
+     where (TALLY1) is (i),
+       actual MOID NEST declarator{46c,d,g,h,o,s,-} ;
+     where (TALLY1) is (TALLY2 i),
+       MOID TALLY2 NEST applied mode indication with TAB2{48b}.
+
+{ The use of TALLY excludes circular chains of mode-definitions such
+  as `mode a = b, b = a'. }
+
+4.3 Priority declarations
+
+4.3.1 Syntax
+
+a) NEST priority declaration of DECS{41a} :
+     priority{94d} token, NEST priority joined definition of DECS{41b,c}.
+b) NEST priority definition of priority PRIO TAD{41c} :
+     priority PRIO NEST definining operator with TAD{48a},
+       is defined as{94d} token, DIGIT{94b} token,
+       where DIGIT counts DIGIT{94b} token,
+       where DIGIT counts PRIO{c,d}.
+   {DIGIT :: digit zero ; digit one ; digit two ; digit three ;
+             digit four ; digit five ; digit six ; digit seven ;
+             digit eight ; digit nine.}
+c) WHETHER DIGIT1 counts PRIO i{b,c} :
+     WHETHER DIGIT2 counts PRIO{c,d},
+       where (digit one igit two digit three digit four
+              digit five digit six digit seven digit eight digit nine)
+              contains (DIGIT2 DIGIT1).
+d) WHETHER digit one counts i{b,c} : WHETHER true.
+
+4.4 Identifier declarations
+
+4.4.1 Syntax
+
+A) MODINE :: MODE ; routine.
+B) LEAP :: local ; heap ; primal.
+
+a) NEST MODINE identity declaration of DECS{41a} :
+     formal MODINE NEST declarer{b,46b},
+       NEST MODINE identity joined definition of DECS{41b,c}.
+b) VICTAL routine NEST declarer{a,523b} : procedure{94d} token.
+c) NEST MODINE identity definition of MODE TAG{41c} :
+     MODE NEST defining identifier with TAG{48a},
+       is defined as{94d} token, MODE NEST source for MODINE{d}.
+d) MODE NEST source for MODINE{c,f,45c} :
+     where (MODINE) is (MODE), MODE NEST source{521c} ;
+     where (MODINE) is (routine), MODE NEST routine text{541a,b,-}.
+e) NEST reference to MODINE variable declaration of DECS{41a} :
+     reference to MODINE NEST LEAP sample generator{523b},
+       NEST reference to MODINE variable joined definition of DECS{41b,c}.
+f) NEST reference to MODINE variable definition
+        of reference to MODE TAG{41c} :
+     reference to MODE NEST defining identifier with TAG{48a},
+       becomes{94c} token, MODE NEST soure for MODINE{d} ;
+     where (MODINE) is (MODE),
+       reference to MODE NEST defining identifier with TAG{48a}.
+
+g) *identifier declaration :
+     NEST MODINE identity declaration of DECS{a} ;
+     NEST reference to MODINE variable declaration of DECS{e}.
+
+4.5 Operation declarations
+
+4.5.1 Syntax
+
+A) PRAM :: DUO ; MONO.
+B) TAO :: TAD ; TAM.
+
+a) NEST MODINE operation delarations of DECS{41a} :
+     operator{94d} token, formal MODINE NEST plan{b,46p,-},
+       NEST MODINE operation joined definition of DECS{41b,c}.
+b) formal routine NEST plan{a} : EMPTY.
+c) NEST MODINE operation definition of PRAM TAO{41c} :
+     PRAM NEST defining operator with TAO{48a},
+       is defined as{94d} token, PRAM NEST source for MODINE{44d}.
+
+4.6 Declarers
+
+4.6.1 Syntax
+
+A) VICTAL :: VIRACT ; formal.
+B) VIRACT :: virtual ; actual.
+C) MOIDS :: MOID ; MOIDS MOID.
+
+a) VIRACT MOID NEST declarer{c,e,g,h,523a,b} :
+     VIRACT MOID NEST declarator{c,d,g,h,o,s,-} ;
+     MOID TALLY NEST applied mode indication with TAB{48b,-}.
+b) formal MOID NEST declarer{e,h,p,r,u,34k,44a,541a,b,e,551a} :
+     where MOID deflexes to MOID{47a,b,c,-},
+       formal MOID NEST declarator{c,d,h,o,s,-} ;
+     MOID1 TALLY NEST applied mode indication with TAB{48b,-},
+       where MOID1 deflexes to MOID{47a,b,c,-}.
+c) VICTAL reference to MODE NEST declarator{a,b,42c} :
+     reference to{94d} token, virtual MODE NEST declarer{a}.
+d) VICTAL structured with FIELDS mode NEST declarator{a,b,42c} :
+     structure{94d} token,
+       VICTAL FIELDS NEST portrayer of FIELDS{e} brief pack.
+e) VICTAL FIELDS NEST portrayer of FIELDS1{d,e} :
+     VICTAL MODE NEST declarer{a,b},
+       NEST MODE FIELDS joined definition of FIELDS1{41b,c} ;
+     where (FIELDS1) is (FIELDS2 FIELDS3),
+       VICTAL MODE NEST declarer{a,b},
+       NEST MODE FIELDS joined definition of FIELDS2{41b,c},
+       and also{94f} token,
+       VICTAL FIELDS NEST portrayer of FIELDS3{e}.
+f) NEST MODE FIELDS definition of MODE field TAG{41c} :
+     MODE field FIELDS defining field selector with TAG{48c}.
+g) VIRACT flexible ROWS of MODE NEST declarator{a,42c} :
+     flexible{94d} token, VIRACT ROWS of MODE NEST declarer{a}.
+h) VICTAL ROWS of MODE NEST declarator{a,b,42c} :
+     VICTAL ROWS NEST rower{i,j,k,l} STYLE bracket,
+       VICTAL MODE NEST declarer{a,b,}.
+i) VICTAL row ROWS NEST rower{h,i} :
+     VICTAL row NEST rower{j,k,l}, and also{94f} token,
+       VICTAL ROWS NEST rower{i,j,k,l}.
+j) actual row NEST rower{h,i} :
+     NEST lower bound{m}, up to{94f} token, NEST upper bound{n} ;
+     NEST upper bound{n}.
+k) virtual row NEST rower{h,i} : up to{94f} token option.
+l) formal row NEST rower{h,i} : up to{94f} token option.
+m) NEST lower bound{j,532f,g} : meek integral NEST unit{32d}.
+n) NEST upper bound{j,532f} : meek integral NEST unit{32d}.
+o) VICTAL PROCEDURE NEST declarator{a,b,42c} :
+     procedure{94d} token, formal PROCEDURE NEST plan{p}.
+p) formal procedure PARAMETY yieling MOID NEST plan{o,45a} :
+     where (PARAMETY) is (EMPTY), formal MOID NEST declarer{b} ;
+     PARAMETERS NEST joined declarer{q,r} brief pack,
+       formal MOID NEST declarer{b}.
+q) PARAMETERS PARAMETER NEST joined declarer{p,q} :
+     PARAMETERS NEST joined declarer{q,r}, and also{94f} token,
+       PARAMETER NEST joined declarer{r}.
+r) MODE parameter NEST joined declarer{p,q} :
+     formal MODE NEST declarer{b}.
+s) VICTAL union of MOODS1 MOOD1 mode NEST declarator{a,b,42c} :
+     unless EMPTY with MOODS1 MOOD1 incestuous{47f},
+       union of{94d} token,
+       MOIDS NEST joined declarer{t,u} brief pack,
+       where MOIDS ravels to MOODS2{47g}
+             and safe MOODS1 MOOD1 subset of safe MOODS2{73l}
+             and safe MOODS2 subset of safe MOODS1 MOOD1{731,m}.
+t) MOIDS MOID NEST joined declarer{s,t} :
+     MOIDS NEST joined declarer{t,u}, an also{94f} token,
+       MOID NEST joined declarer{u}.
+u) MOID NEST joined declarer{s,t} : formal MOID NEST declarer{b}.
+
+4.7 Relationships between modes
+
+4.7.1 Syntax
+
+A) NONSTOWED :: PLAIN ; REF to MODE ; PROCEDURE ; UNITED ; void.
+B) MOODSETY :: MOODS ; EMPTY.
+C) MOIDSETY :: MOIDS ; EMPTY.
+
+a) WHETHER NONSTOWED deflexes to NONSTOWED{b,e,46b,521c,62a,71n} :
+     WHETHER true.
+b) WHETHER FLEXETY ROWS of MODE1 deflexes to ROWS of MODE2{b,e,46b,521c,62a,71n} :
+     WHETHER MODE1 deflexes to MODE2{a,b,c,-}.
+c) WHETHER structured with FIELDS1 mode deflexes to
+           structured with FIELDS2 mode{b,e,46b,521c,62a,71n} :
+     WHETHER FIELDS1 deflexes to FIELDS2{d,e,-}.
+d) WHETHER FIELDS1 FIELD1 deflexes to FIELDS2 FIELD2{c,d} :
+     WHETHER FIELDS1 deflexes to FIELDS2{d,e,-}
+             and FIELD1 deflexes to FIELD2{e,-}.
+e) WHETHER MODE1 field TAG deflexes to MODE2 field TAG{c,d} :
+     WHETHER MODE1 deflexes to MODE2{a,b,c,-}.
+
+f) WHETHER MOODSETY1 with MOODSETY2 inestuous{f,46s} :
+     where (MOODSETY2) is (MOOD MOODSETY3),
+       WHETHER MOODSETY1 MOOD with MOODSETY3 incestuous{f}
+               or MOOD is firm union of MOODSETY1 MOODSETY3 mode{71m} ;
+     where (MOODSETY2) is (EMPTY), WHETHER false.
+
+g) WHETHER MOIDS ravels to MOODS{g,46s} :
+     where (MOIDS) is (MOODS), WHETHER true ;
+     where (MOIDS) is
+           (MOODSETY union of MOODS1 mode MOIDSETY),
+       WHETHER MOODSETY MOODS1 MOIDSETY ravels to MOODS{g}.
+
+{ The hyperrules from a) to e) implement a predicate deflexes-to that
+  determines whether a given mode deflexes to another mode.  Any
+  non-stowed mode deflexes to any other non-stowed mode.  A row mode
+  deflexes to another row mode if the ranks of the modes are the same
+  and the mode of the former's elements deflexes to the mode of the
+  later's elements.  A structured mode deflexes to another structured
+  mode if they have the same number of fields with the same tags and
+  their modes deflex.  }
+
+{ The hyperrule f) implements a predicate that determines whether two
+  provided sets of moods are incestuous, i.e. whether they contain
+  modes which are firmly related.  }
+
+{ The hyperrule g) determines whether a set of moods and
+  united modes may be ravelled.  }
+
+4.8 Indicators and field selectors
+
+4.8.1 Syntax
+
+{ Extensions:
+  [MR] INK, "module indication", "module REVS", "invoked", TAU }
+
+A) INDICATOR :: identifier ; mode indication ; operator ;
+                module indication.
+B) DEFIED :: defining ; applied.
+C) PROPSETY :: PROPS ; EMPTY.
+D) PROPS :: PROP ; PROPS PROP.
+E) PROP :: DEC ; LAB ; FIELD ; INK.
+F) QUALITY :: MODE ; MOID TALLY ; DYADIC ; label ; MODE field ;
+              module REVS ; invoked.
+G) TAX :: TAG ; TAB ; TAD ; TAM ; TAU.
+
+a) QUALITY NEST new PROPSETY1 QUALITY TAX PROPSETY2
+           defining INDICATOR with TAX{32c,35b,42b,43b,44c,f,45c,541f} :
+     where QUALITY TAX independent PROPSETY1 PROPSETY2{71a,b,c},
+       TAX{942A,D,F,K} token.
+b) QUALITY NEST applied INDICATOR with TAX{42c,46a,b,5D,542a,b,544a} :
+     where QUALITY TAX identified in NEST{72a},
+       TAX{942A,D,F,K} token.
+c) MODE field PROPSETY1 MODE field TAG PROPSETY2 defining
+        field selector with TAG{46f} :
+     where MODE field TAG independent PROPSETY1 PrOPSETY2{71a,b,c},
+       TAX{942A} token.
+d) MODE field FIELDS applied field selector with TAG{531a} :
+     where MODE field TAG resides in FIELDS{72b,c,-},
+       TAG{942A} token.
+
+e) *QUALITY NEST DEFIED indicator with TAX :
+     QUALITY NEST DEFIED INDICATOR with TAX{a,b}.
+f) *MODE DEFIED field seletor with TAG :
+     MODE field FIELDS DEFIED field selector with TAG{c,d}.
+
+{ MODs are introduced into a nest by module-declarations.
+  INKs are introduced into a nest by module-calls. }
+
+{ Modules are ascribed to module-indications by means of
+  module-declarations.  }
+
+4.9 Module declarations
+
+4.9.1 Syntax
+
+a) NEST1 module declaration of MODS{41a,e} :
+     module{94d} token,
+       NEST1 module joined definition of MODS{41b,c}.
+b) NEST1 module definition of module RESETY REV TAB{41c} :
+     where (REV) is (TAU reveals DECSETY invoked TAU)
+           and (TAB) is (bold TAG),
+       where (NEST1) is (NOTION1 invoked TAU NOTETY2),
+       unless (NOTION1 NOTETY2) contains (invoked TAU),
+       module REVSETY REV NEST1 defining module indication with TAB{48a},
+       is define as{94d} token,
+       NEST1 module text publishing REVSETY REV defining LAYER{c,-}.
+c) NEST1 module text
+         publishing REVSETY TAU reveals DECSETY INKSETY INK
+         defining new DECSETY1 DECSETY INK{b} :
+     where (INKSETY) is (EMPTY) and (REVSETY) is (EMPTY),
+       def{94d} token,
+       NEST1 new new DECSETY1 DECSETY INK module series
+             with DECSETY without DECSETY1{d},
+       fed{94d} token ;
+     NEST1 revelation publishing REVSETY defining LAYER{36b},
+       def{94d} token,
+       NEST1 LAYER new DECSETY1 DECSETY INK module series
+             with DECSETY without DECSETY1{d},
+       fed{94d} token,
+       where (LAYER) is (new DECSETY2 INKSETY).
+d) NEST3 module series with DECSETY without DECSETY1{c} :
+     NEST3 module prelude with DECSETY without DECSETY1{e},
+       NEST3 module postlude{f} option.
+e) NEST3 module prelude with DECSETY1 without DECSETY2{d,e} :
+     strong void NEST3 unit{32d}, go on{94f} token,
+       NEST3 module prelude with DECSETY1 without DECSETY2{e} ;
+     where (DECSETY1 without DECSETY2) is
+           (DECSETY3 DECSETY4 without DECSETY5 DECSETY6>,
+       NEST3 declaration with DECSETY3 without DECSETY5{41e},
+       go on{94f} token,
+       NEST3 module prelude with DECSETY4 without DECSETY6{e} ;
+     where (DECSETY1 without DECSETY2) is (EMPTY without EMPTY),
+       strong void NEST3 unit{32d} ;
+     NEST3 declaration with DECSETY1 without DECSETY2{41e}.
+f) NEST3 module postlude{d} :
+     postlude{94d} token, strong void NEST3 series with EMPTY{32b}.
+
+g) *module text :
+     NEST module text publishing REVS defining LAYER{c}.
+
+{ Examples:
+    a) MODULE A = DEF STRING s; gets (s);
+                      PUB STRING t = "file"+s, PUB REAL a FED,
+              B = ACCESS A DEF PUB INT fd;
+                               fopen (fd, file o rdonly)
+                           POSTLUDE close (f) FED
+
+    b) A = DEF STRING s; gets (s);
+               PUB STRING t = "file"+s, PUB REAL a FED
+
+       B = ACCESS A DEF PUB FILE f;
+                        fopen (fd, file o rdonly)
+                        POSTLUDE close (f) FED
+
+    c) DEF STRING s; gets (s);
+           PUB STRING t = "file"+s, PUB REAL a FED
+
+       ACCESS A DEF PUB FILE f;
+                        fopen (fd, file o rdonly)
+                        POSTLUDE close (f) FED
+
+    d) STRING s; gets (s); PUB STRING t = "file"+s, PUB real a
+
+       PUB FILE f; fopen (fd, file o rdonly) POSTLUDE close (f)
+
+    e) STRING s; gets (s); PUB STRING t = "file"+s, PUB real a
+
+       PUB FILE f; fopen (fd, file o rdonly)
+
+    f) POSTLUDE close (f) }
+
+{ Note that the EMPTY (for PROPSETY) in rule f enforces that a module
+  postlude cannot contain declarations, labels or module accesses.
+  Only units are allowed.  }
+
+{ Rule b ensures that a unique 'TAU' is associated with each
+  module-text accessible from any given point in the program.  This is
+  used to ensure that an invoke ATU' can be identified in the nest of
+  all descendent constructs of any access-clause or module-text which
+  invokes that module-text.
+
+  In general, a module-text-publishing-REVS-defining-LAYER T makes
+  'LAYER' visible within itself, and makes the properties revealed by
+  'REVS' visible wherever T is accessed.  'LAYER' includes both a
+  'DECSETY' corresponding to its public declarations and an INK' which
+  links T to its unique associated 'TAU' and signifies in the nest
+  that T is now known to be invoked.  REVS' always reveals 'DECSETY
+  INKSETY INK' (but not 'DECSETY1'), where INKSETY' signifies the
+  invocation of any other modules accessed by T.  'REVS' may also
+  reveal the publications of the other modules accessed by T if their
+  module-calls within T contained a public-token. }
+
+5 Units
+
+5.1 Syntax
+
+{ Extensions:
+  [MR] formal hole, virtual hole }
+
+A) UNIT{32d} ::
+     assignation{521a} coercee ; identity relation{522a} coercee ;
+     routine text{541a,b} coercee ; jump{544a} ; skip{552a} ;
+     and function{57a} ; or function{57b} ;
+     formal hole{561b} ; virtual hole{561a} ;
+     TERTIARY{B}.
+B) TERTIARY{A,521b,522a} ::
+     ADIC formula{542a,b} coercee ; nihil ;
+     SECONDARY{C}.
+C) SECONDARY{B,531a,542c} ::
+     LEAP generator{523a} coercee ; selection{531a} coercee ;
+     PRIMARY{D}.
+D) PRIMARY{C,532a,543a} ::
+     slice{532a} coercee ; call{543a} coercee ;
+     format text{A341a} coercee ;
+     applied identifier with TAG{48b} coercee ;
+     ENCLOSED clause{31a,33a,c,d,e,34a,35a}.
+
+a) *SOME hip :
+     SOME jump{544a} : SOME skip{552a} ; SOME nihil{524a}.
+
+5.2 Units associated with names
+
+5.2.1 Assignations
+
+5.2.1.1 Syntax
+
+a) REF to MODE NEST assignation{5A} :
+     REF to MODE NEST destination{b}, becomes{94c} token,
+       MODE NEST source{c}.
+b) REF to MODE NEST destination{a} :
+     soft REF to MODE NEST TERTIARY{5B}.
+c) MODE1 NEST source{a,44d} :
+     strong MODE2 NEST unit{32d},
+       where MODE1 deflexes to MODE2{47a,b,c,-}.
+
+5.2.2 Identity relations
+
+5.2.2.1 Syntax
+
+a) boolean NEST identity relation{5A} :
+     where soft balances SORT1 and SORT2{32f},
+       SORT1 reference to MODE NEST TERTIARY1{5B},
+       identity relator{b},
+       SORT2 reference to MODE NEST TERTIARY2{5B}.
+b) identity relator{a} : is{94f} token ; is not{94f} token.
+
+5.2.3 Generators
+
+5.2.3.1 Syntax
+
+a) reference to MODE NEST LEAP generator{5C} :
+     LEAP{94d,-} token, actual MODE NEST declarer{46a}.
+b) reference to MODINE NEST LEAP sample generator{44e} :
+     LEAP{94d,-} token, actual MODINE NEST declarer{44b,46a} ;
+     where (LEAP) is (local), actual MODINE NEST declarer{44b,46a}.
+
+5.2.4 Nihils
+
+5.2.4.1 Syntax
+
+a) strong reference to MODE NEST nihil{5B} :
+     nil{94f} token.
+
+5.3 Units associated with stowed values
+
+5.3.1 Selections
+
+5.3.1.1 Syntax
+
+A) REFETY :: REF to ; EMPTY.
+B) REFLEXETY :: REF to ; REF to flexible ; EMPTY.
+
+a) REFETY MODE1 NEST selection{5C} :
+     MODE1 field FIELDS applied field selector with TAG{48d},
+       of{94f} token, weak REFLEXETY ROWS of structured with
+                           FIELDS mode NEST SECONDARY{5C},
+       where (REFETY) is derived from (REFLEXETY){b,c,-}.
+b) WHETHER (transient reference to) is derived from
+           (REF to flexible){a,532,66a} :
+     WHETHER true.
+c) WHETHER (REFETY) is derived from (REFETY){a,532a,66a} :
+     WHETHER true.
+
+5.3.2 Slices
+
+5.3.2.1 Syntax
+
+A) ROWSETY :: ROWS ; EMPTY.
+
+a) REFETY MODE1 NEST slice{5D} :
+     weak REFLEXETY ROWS1 of MODE1 NEST PRIMARY{5D},
+       ROWS1 leaving EMPTY NEST indexer{b,c,-} STYLE bracket,
+       where (REFETY) is derived from (REFLEXETY){531b,c,-} ;
+     where (MODE1) is (ROWS2 of MODE2),
+       weak REFLEXETY ROWS1 of MODE2 NEST PRIMARY{5D},
+       ROWS1 leaving ROWS2 NEST indexer{b,d,-} STYLE bracket,
+       where (REFETY) is derived from (REFLEXETY){531b,c,-}.
+b) row ROWS leaving ROWSETY1 ROWSETY2 NEST indexer{a,b} :
+     row leaing ROWSETY1 NEST indexer{c,d,-}, and also{94f} token,
+       ROWS leaving ROWSETY2 NEST indexer{b,c,d,-}.
+c) row leaving EMPTY NEST indexer{a,b} : NEST subscript{3}.
+d) row leaving row NEST indexer{a,b} :
+     NEST trimmer{f} ; NEST revised lower bound{g} option.
+e) NEST subscript{c} : meek integral NEST unit{32d}.
+f) NEST trimmer{d} :
+     NEST lower bound{46m} option, up to{94f} token,
+       NEST upper bound{46n} option,
+       NEST revised lower bound{g} option.
+g) NEST revised lower bound{d,f} :
+     at{94f} token, NEST lower bound{46m}.
+
+h) *trimscript :
+     NEST subscript{e} ; NEST trimmer{f};
+     NEST revised lower bound{g} option.
+i) *indexer :
+     ROWS leaving ROWSETY NEST indexer{b,c,d}.
+j) *boundscript :
+     NEST subscript{e} ; NEST lower bound{46m} ;
+     NEST upper bound{46n} ; NEST revised lowe bound{g}.
+
+5.4 Units associated with routines
+
+5.4.1 Routine texts
+
+5.4.1.1 Syntax
+
+a) procedure yielding MOID NEST1 routine text{44d,5A} :
+     formal MOID NEST1 declarer{46b}, routine{94f} token,
+       strong MOID NEST1 unit{32d}.
+b) procedure with PARAMETERS yielding
+             MOID NEST1 routine text{44d,5A} :
+     NEST1 new DECS2 declarative defining
+           new DECS2{e} brief pack,
+       where DECS2 like PARAMETERS{c,d,-},
+       formal MOID NEST1 declarer{46b}, routine{94f} token,
+       strong MOID NEST1 new DECS2 unit{32d}.
+c) WHETHER DECS DEC like PARAMETERS PARAMETER{b,c} :
+     WHETHER DECS like PARAMETERS{c,d-}
+             and DEC like PARAMETER{d,-}.
+d) WHETHER MODE TAG like MODE parameters{b,c} :
+     WHETHER true.
+e) NEST2 declarative defining new DECS2{b,e,34j} :
+     formal MODE NEST2 declarer{46b},
+       NEST2 MODE parameter joined definition of DECS2{41b,c} ;
+     where (DECS2) is (DECS3 DECS4),
+       formal MODE NEST2 declarer{46b},
+       NEST2 MODE parameter joind definition of DECS3{41b,c},
+       and also{94f} token, NEST2 declarative defining new DECS4{3}.
+f) NEST2 MODE parameter efinition of MODE TAG2{41c} :
+     MDOE NEST2 defining identifier with TAG2{48a}.
+
+g) *formal MODE parameter :
+     NEST MODE parameter definition of MODE TAG{f}.
+
+5.4.2 Formulas
+
+5.4.2.1 Syntax
+
+A) DYADIC :: priority PRIO.
+B) MONADIC :: priority iii iii iii i.
+C) ADIC :: DYADIC ; MONADIC.
+D) TALLETY :: TALLY ; EMPTY.
+
+a) MOID NEST DYADIC formula{c,5B} :
+     MODE1 NEST DYADIC TALLETY operand{c,-},
+       procedure with MODE1 parameter MODE2 parameter
+                 yielding MOID NEST applied operator with TAD{48b},
+       where DYADIC TAD identified in NEST{72a},
+       MODE2 NEST DYADIC TALLY operand{c,-}.
+b) MOID NEST MONADIC formula{c,5B} :
+     procedure with MODE parameter yielding MOID
+               NEST applied operator ith TAM{48b},
+       MODE NEST MONADIC operand{c}.
+c) MODE NEST ADIC operand{a,b} :
+     firm MODE NEST ADIC formula{a,b} coercee{61b} ;
+     where (ADIC) is (MONADIC), firm MODE NEST SECONDARY{5C}.
+
+d) *MOID formula : MOID NEST ADIC formula{a,b}.
+e) *DUO dyadic operator with TAD :
+     DUO NEST DEFIED operator with TAD{48a,b}.
+f) *MONO monadic operator with TAM :
+     MONO NEST DEFIED operator with TAM{48a,b}.
+g) *MODE operand : MODE NEST ADIC operand{c}.
+
+5.4.3 Calls
+
+5.4.3.1 Syntax
+
+a) MOID NEST call{5D} :
+     meek procedure with PARAMETERS yielding MOID NEST PRIMARY{5D},
+       actual NEST PARAMETERS{b,c} brief pack.
+b) actual NEST PARAMETERS PARAMETER{a,b} :
+     actual NEST PARAMETERS{b,c}, and also{94f} token,
+       actual NEST PARAMETER{c}.
+c) actual NEST MODE parameter{a,b} : strong MODE NEST unit{32d}.
+
+5.4.4 Jumps
+
+5.4.4.1 Syntax
+
+a) strong MOID NEST jump{5A} :
+     go to{b} option,
+       label NEST applied identifier with TAG{48b}.
+b) go to{a} : STYLE go to{94f,-} token ;
+              STYLE go{94f,-} token, STYLE to symbol{94g,-}.
+
+5.5 Units associated with values of any mode
+
+5.5.1 Casts
+
+5.5.1.1 Syntax
+
+a) MOID NEST cast{5D} :
+     formal MOID NEST declarer{46b},
+       strong MOID NEST ENCLOSED clause{31a,33c,d,e,34a,35a,-}.
+
+5.5.2 Skips
+
+5.5.2.1 Syntax
+
+a) strong MOID NEST skip{5A} : skip{94f} token.
+
+5.6 Holes
+
+5.6.1 Syntax
+
+A) LANGUAGE :: algol sixty eight ; fortran ; c language ; cpp language.
+B) ALGOL68 :: algol sixty eight.
+C) FORTRAM :: fortran.
+D) CLANG :: c language.
+E) CPPLANG :: cpp language.
+F) DLANG :: d language.
+
+a) strong MOID NEST virtual hole{5A} :
+     virtual nest symbol, strong MOID NEST closed clause{31a}.
+b) strong MOID NEST formal hole{5A} :
+     formal nest{94d} token, MOID LANGUAGE indication{e,f,-},
+       hole indication{d}.
+c) MOID NEST actual hole{A6a} :
+     strong MOID NEST ENCLOSED clause{31a,33a,c,34a,35a,36a,-}.
+d) hole indication{b} :
+     character denotation{814a} ; row of character denotation{83a}.
+e) MOID ALGOL68 indication{b} : EMPTY.
+f) MOID FORTRAN indication{b} : bold letter f letter o letter r letter t
+                                     letter r letter a letter n token.
+g) MOID CLANG indication{b} : bold letter c letter l letter a letter n
+                                   letter g.
+e) MOID CPPLANG indication{b} : bold letter c letter p letter p letter l
+                                     letter a letter n letter g.
+f) MOID DLANG indication{b} : bold letter d letter l letter a letter n
+                                   letter g.
+
+{ Since no representation is provided for the virtual-nest-symbol, the
+  user is unable to construct virtual-holes for himself, but a
+  mechanism is provided (10.6.2.a) for constructing them out of
+  formal- and actual-holes. }
+
+5.7 Short-circuit logical functions
+
+{ Extensions: [SC] }
+
+{ The short-circuit logical functions are pseudo-operators providing
+  logical AND and OR functions with short-circuited elaboration.  }
+
+5.7.1 Syntax
+
+a) boolean NEST and function{5A} :
+     meek boolean NEST TERTIARY1, andth{94c} token, meek boolean NEST TERTIARY2.
+
+b) boolean NEST or function{5A} :
+     meek boolean NEST TERTIARY1, orel{94c} token, meek boolean NEST TERTIARY2.
+
+c) *boolean NEST short circuit function :
+     boolean NEST and function{a} ; boolean NEST or function{b}.
+
+{ Examples:
+    a) UPB str > 2 ANDTH str[3] /= "x"
+    b) error = 0 OREL (print ("error"); stop; SKIP) }
+
+6 Coercion
+
+6.1 Coercees
+
+6.1.1 Syntax
+
+A) STRONG{a,66a} ::
+     FIRM{B} ; widened to{65a,b,c,d} ; rowed to{66a} ;
+     voided for{67a,b}.
+B) FIRM{A,b} :: MEEK{C} ; united to{64a}.
+C) MEEK{B,c,d,64a,63a,64a,65a,b,c,d} ::
+     unchanged from{f} ; dereferenced to{62a} ; deprocedured to{63a}.
+D) SOFT{e,63b} ::
+     unchanged from{f} ; softly deprocedured to{63b}.
+E) FORM :: MORF ; COMORF.
+F) MORF ::
+     NEST selection ; NEST slice ; NEST routine text ;
+     NEST ADIC formula ; NEST call ;
+     NEST applied identifier with TAG.
+G) COMORF ::
+     NEST assignation ; NEST identity relation ;
+     NEST LEAP generator ; NEST cast ; NEST denoter ;
+     NEST format text.
+
+a) strong MOID FORM coercee{5A,B,C,D,A341i} :
+     where (FORM) is (MORF), STRONG{A} MOID MORF ;
+     where (FORM) is (COMORF), STRONG{A} MOID COMORF,
+       unless (STRONG MOID) is (deprocedured to void).
+b) firm MODE FORM coercee{5A,B,C,D,542c} : FIRM{B} MODE FORM.
+c) meek MODE FORM coercee{5A,B,C,D} : MEEK{C} MOID FORM.
+d) weak REFETY STOWED FORM coercee{5A,B,C,D} :
+     MEEK{C} REFETY STOWED FORM,
+       unless (MEEK) is (dereferenced to)
+              and (REFETY) is (EMPTY).
+e) soft MODE FORM coercee{5A,B,C,D} : SOFT{D} MODE FORM.
+f) unchanged from MOID FORM{C,D,67a,b} : MOID FORM.
+
+g) *SORT MOID coercee : SORT MOID FORM coercee{a,b,c,d,e}.
+h) *MOID coercend : MOID FORM.
+
+{ Examples:
+    a) 3.14 (in x := 3.14)
+    b) 3.14 (in x + 3.14)
+    c) sin (in sin (x))
+    d) x1 (in x1[2] := 3.14)
+    e) x (in x := 3.14)  }
+
+6.2 Dereferencing
+
+6.2.1 Syntax
+
+a) dereferenced to{61C} MODE1 FORM :
+     MEEK{61C} REF to MODE2 FORM,
+       where MODE2 deflexes to MODE1{47a,b,c,-}.
+
+{ Examples:
+    a) x in (real (x)) }
+
+6.3 Deproceduring
+
+6.3.1 Syntax
+
+a) deprocedured to{61C,67a} MOID FORM :
+     MEEK{61C} procedure yielding MOID FORM.
+b) softly deprocedured to{61D} MODE FORM :
+     SOFT{61D} procedure yielding MODE FORM.
+
+{ Examples:
+    a) random (in real (random))
+    b) x or y (in x or y := 3.14, given
+               PROC x or y = REF REAL: (random < .5 | x | y)) }
+
+6.4 Uniting
+
+6.4.1 Syntax
+
+a) united to{64B} UNITED FORM :
+     MEEK{61C} MOID FORM,
+       where MOID unites to UNITED{b}.
+b) WHETHER MOID1 unites to MOID2{a,34i,71m} :
+     where MOID1 equivalent MOID2{73a}, WHETHER false ;
+     unless MOID1 equivalent MOID2{73a},
+       WHETHER safe MOODS1 subset of safe MOODS2{73l,m,n},
+       where (MOODS1) is (MOID1)
+             or (union of MOODS1 mode) is (MOID1),
+       where (MOODS2) is (MOIDS2)
+             or (union of MOODS2 mode) is (MOIDS2).
+
+{ Examples:
+    a) x (in uir := x)
+       u (in UNION(CHAR,INT,VOID)(u), in a reach containing
+          UNION(INt,VOID) u := EMPTY) }
+
+6.5 Widening
+
+6.5.1 Syntax
+
+A) BITS :: structured with
+                      row of boolean field SITHETY letter aleph mode.
+B) BYTES :: structured with
+                       row of character field SITHETY letter aleph mode.
+C) SITHETY :: LENGTH LENGTHETY ; SHORT SHORTHETY ; EMPTY.
+D) LENGTH :: letter l letter o letter n letter g.
+E) SHORT :: letter s letter h letter o letter r letter t.
+F) LENGTHETY :: LENGTH LENGTHETY ; EMPTY.
+G) SHORTHETY :: SHORT SHORTHETY ; EMPTY.
+
+a) widened to{b,61A} SIZETY real FORM :
+     MEEK{61C} SIZETY integral FORM.
+b) widened to{61A} structured with SIZETY real field letter r letter e
+           SIZETY real field letter i letter m mode FORM :
+     MEEK{61C} SIZETY real FORM ;
+     widened to{a} SIZETY real FORM.
+c) widened to{61A} row of boolean FORM : MEEK{61C} BIT FORM.
+d) widened to{61A} row of character FORM : MEEK{61C} BYTES FORM.
+
+{ Examples:
+    a) 1 (in x := 1)
+    b) 1.0 (in z := 1.0)
+       1 (in z := 1)
+    c) 2r101 (in []BOOL(2r101))
+    d) r (in []CHAR(r)) }
+
+6.6 Rowing
+
+6.6.1 Syntax
+
+a) rowed to{61A} REFETY ROWS1 of MODE FORM :
+     where (ROWS1) is (row),
+       STRONG{61A} REFLEXETY MODE FORM,
+       where (REFETY) is derived from (REFLEXETY){531b,c,-} ;
+     where (ROWS1) is (row ROWS2),
+       STRONG{61A} REFLEXETY ROWS2 of MODE FORM,
+       where (REFETY) is derived from (REFLEXETY){531b,c,-}.
+
+{ Examples:
+    a) 4.13 (in [1:1]REAL b1 := 4.13)
+       x1 (in [1:1,1:n]REAL b2 := x1) }
+
+6.7 Voiding
+
+6.7.1 Syntax
+
+A) NONPROC :: PLAIN ; STOWED ; REF to NONPROC ;
+              procedure with PARAMETERS yielding MOID ; UNITED.
+
+a) voided to{61A} void MORF :
+     deprocedured to{63a} NONPROC MORF ;
+     unchanged from{61f} NONPROC MORF.
+b) voided to{61A} void COMORF :
+     unchanged from{61f} MODE COMORF.
+
+{ Examples:
+    a) random (in SKIP; random;)
+       next random (last random)
+         (in SKIP; next random (lat random);)
+    b) PROC VOID (pp) (in PROC PROC VOID pp = PROC VOID : (print (1);
+            VOID : print (2)); PROC VOID (pp);) }
+
+8 Denotations
+
+8.1 Plain denotations
+
+8.1.0.1 Syntax
+
+A) SIZE:: long ; short.
+B) *NUMERAL :: fixed point numeral ; variable point numeral ;
+               floating point numeral.
+
+a) SIZE INTREAL denotation{a,80a} :
+     SIZE symbol{94d}, INTREAL, denotation{a,811a,812a}.
+
+b) *plain denotation :
+     PLAIN denotation{a,811a,812a,813a,814a} ; void denotation{815a}.
+
+{ Example:
+    a) LONG 0 }
+
+8.1.1 Integral denotations
+
+8.1.1.1 Syntax
+
+a) integral denotation{80a,810a} : fixed point numeral{b}.
+b) fixed point numeral{a,812c,d,f,i,A341h} : digit cypher{c} sequence.
+c) digit cypher{b} : DIGIT symbol{94b}.
+
+{ Examples:
+    a) 4096
+    b) 4096
+    c) 4 }
+
+8.1.2 Real denotations
+
+8.1.2.1 Syntax
+
+a) real denotation{80a,810a} :
+     variable point numeral{b} ; floating point numeral{e}.
+b) variable point numeral{a,f} :
+     integral part{c} option, fractional part{d}.
+c) integral part{b} : fixed point numeral{811b}.
+d) fractional part{b} : point symbol{94b}, fixed point numeral{811b}.
+e) floating point numeral{a} : stagnant part{f}, exponent part{g}.
+f) stagnant part{e} :
+     fixed point numeral{811b} : variable point numeral{b}.
+g) exponent part{e} :
+     times ten to the power choice{h}, power of then{i}.
+h) times ten to the power choice{g} :
+     times ten to the power symbol{94b} ; letter e symbol{94a}.
+i) power of ten{g}: plusminus{j} option, fixed point numeral{811b}.
+j) plusminus{i} : plus symbol{94c} ; mius symbol{94c}.
+
+{ Examples:
+    a) 0.00123
+       1.23e-3
+    b) 0.00123
+    c) 0
+    d) .00123
+    e) 1.23e-3
+    f) 123
+       1.23
+    g) E-3
+    h) E
+    i) -3
+    j) +
+       - }
+
+8.1.3 Boolean denotations
+
+8.1.3.1 Syntax
+
+a) boolean denotation{80a} : true{94b} symbol ; false{94b} smbol.
+
+{ Examples:
+    a) TRUE
+       FALSE }
+
+8.1.4 Character denotations
+
+8.1.4.1 Syntax
+
+a) character denotation{80a} :
+     quote{94b} symbol, string item{b}, quote sybol{94b}.
+b) string item{a,83b} :
+     character glyph{c} ; quote image symbol{94f} ; other string item{d}.
+c) character glyph{b,92c} :
+     LETTER symbol{94a} ; DIGIT symbol{94b} ;
+     point sybol{94b} ; open symbol{94f} ; close symbol{94f} ;
+     comma symbol{94b} ; space symbol{94b} ;
+     plus symbol{94c} ; minus symbol{94c}.
+
+{ A production rule may be added for the notion 'other string item'
+  each of whose alternatives is a symbol 1.1.3.1.f which is different
+  from any terminal production of 'character glyph' and which is not
+  'quote symbol' }
+
+{ Examples:
+    a) "a"
+    b) a
+       ""
+       ?
+    c) a 1 . ( ) , . space + - }
+
+8.1.5 Void denotation
+
+5.1.5.1 Syntax
+
+a) void denotation{80a} : empty{94b} symbol.
+
+{ Example:
+    a) EMPTY }
+
+8.2 Bits denotations
+
+8.2.1 Syntax
+
+A) RADIX :: radix two ; radix four ; radix eight ; radix sixteen.
+
+a) structured with row of boolean field
+              LENGTH LENGTHETY letter aleph mode denotation{a,80a} :
+     long{94d} symbol, structured with row of boolean field
+                                  LENGTHETY letter aleph mode denotation{a,c}.
+b) structured with row of boolean field
+              SHORT SHORTHTETY letter aleph mode denotation{b,80a} :
+     short{94d} symbol,
+       structured with row of boolean field SHORTHETY letter aleph mode denotation{b,c}.
+c) structured wih row of boolean field
+              letter aleph mode denotation{a,b,80a} :
+     RADIX{d,e,f,g}, letter r symbol{94a}, RADIX digit{h,i,j,k} sequence.
+d) radix two{c,A347b} : digit two{94b} symbol.
+e) radix four{c,A347b} : digit four{94b} symbol.
+f) radix eight{c,A347b} : digit eight{94b} symbol.
+g) radix sixteen{c,A347b} : digit one symbol{94b}, digit six symbol{94b}.
+h) radix two digit{c,i} : digit zero symbol{94b} ; digit one symbol{94b}.
+i) radix four digit{c,j} :
+     radix two digit{h} ; digit two symbol{94b} ;
+     digit three symbol{94b}.
+j) raidx eight digit{c,k} :
+     radix four digit{i} ; digit four symbol{94b} ;
+     digit five symbol{94b} ; digit six symbol{94b} ;
+     digit seven symbol{94b}.
+k) radix sixteen digit{c} :
+     radix eight digit{j} ; digit eight symbol{94b} ;
+     digit nine symbol{94b} ; letter a symbol{94a} ;
+     letter b symbol{94a} ; letter e symbol{94a} ; letter d symbol{94a} ;
+     letter e symbol{94a} ; letter f symbol{94a}.
+
+l) *bits denotation : BITS denotation{a,b,c}.
+m) *radix digit : RADIX digit{h,i,j,k}.
+
+{ Examples:
+    a) LONG 2r101
+    b) SHORT 16rffff
+    c) 8r231 }
+
+8.3 String denotations
+
+8.3.1 Syntax
+
+a) row of character denotation{80a} :
+     quote{94b} symbol, string{b} option, quote symbol{94b}.
+b) string{a} : string item{814b}, string item{814b} sequence.
+
+c) *string denotation : row of charater denotation{a}.
+
+{ Examples:
+    a) "abc"
+    b) abc }
+
+9 Tokens and symbols
+
+9.1 Tokens
+
+{ Tokens are symbols possibly preceded by pragments.  }
+
+9.1.1 Syntax
+
+a) CHOICE STYLE start{34a} :
+     where (CHOICE) is (choice using boolean),
+       STYLE if{94f,-} token ;
+     where (CHOICE) is (CASE), STYLE case{94f,-} token.
+b) CHOICE STYLE in{34e} :
+     where (CHOICE) is (choice using boolean),
+       STYLE then{94f,-} token ;
+     where (CHOICE) is (CASE), STYLE in{94f,-} token.
+c) CHOICE STYLE again{34l} :
+     where (CHOICE) is (choice using boolean),
+       STYLE else if{94f,-} token ;
+     where (CHOICE) is (CASE), STYLE ouse{94f,-} token.
+d) CHOICE STYLE out{34l} :
+     where (CHOICE) is (choice using boolean),
+       STYLE else{94f,-} token ;
+     where (CHOICE) is (CASE), STYLE out{94f,-} token.
+e) CHOICE STYLE finish{34a} :
+     whre (CHOICE) is (choice using boolean),
+       STYLE fi{94f,-} token ;
+     where (CHOICE) is (CASE), STYLE esac{94f,-} token.
+f) NOTION token :
+     pragment{92a} sequence option,
+       NOTION symbol{94a,b,c,d,e,f,g,h}.
+
+g) *token : NOTION token{f}.
+h) *symbol : NOTION symbol{94a,b,c,d,e,f,g,h}.
+
+9.2 Comments and pragmats
+
+9.2.1 Syntax
+
+{ Extensions:
+  [NC] nestable comments.  }
+
+A) PRAGMENT :: pragmat ; comment.
+
+a) pragment{80a,91f,A341b,h,A348a,b,c,A349a,A34Ab} : PRAGMENT{b}.
+b) PRAGMENT{a} :
+     STYLE PRAGMENT symbol{94h,-},
+       STYLE PRAGMENT item{c} sequence option,
+       STYLE PRAGMENT symbol{94h,-} ;
+     STYLE nestable comment{d}.
+c) STYLE PRAGMENT item{b} :
+     character glyph{814c} ; STYLE other PRAGMENT item{d}.
+d) STYLE nestable comment{b} :
+     STYLE comment begin symbol{94h,-},
+       STYLE nestable comment contents{e} sequence,
+       STYLE comment end symbol{94h,-}.
+e) STYLE nestable comment contents{d} :
+     STYLE nestable comment item{c} sequence option,
+       STYLE nestable comment{d} option.
+f) STYLE nestable comment item{e} :
+     character glyph{814c} ; STYLE other nestable comment item{d}.
+
+{ A production rule may be added for each notion designated by 'STYLE
+  other PRAGMENT item' each of whose alternatives is a symbol
+  different from any terminal production of 'character glyph', and
+  such that no terminal production of any 'STYLE other PRAGMENT item'
+  is the corresponding 'STYLE PRAGMENT symbol'.  This allows to nest
+  different comment or pragmat for example.  }
+
+9.4 The reference language
+
+9.4.1 Representations of symbols
+
+{ Extensions:
+  [CS] andth symbol, orel symbol
+  [MR] access symbol
+  [US] unsafe symbol }
+
+{ This section of the Report doesn't describe syntax, but lists all
+  the different symbols along with their representation in the
+  reference language.  We only include here symbols corresponding to
+  the GNU extensions implemented by this compiler.  }
+
+        symbol                         representation
+
+c) andth symbol{57a}                    ANDTH
+   orel symbol{57b}                     OREL
+d) access symbol{36b}                   ACCESS
+f) unsafe symbol{37a}                   UNSAFE
+h) bold comment begin symbol{92a}       NOTE
+   bold comment end symbol{92a}         ETON
+   brief comment begin symbol{92a}      {
+   brief comment end symbol{92a}        }
+
+10.1.1 Syntax
+
+{ Extensions:
+  [MR] user, user task }
+
+A) EXTERNAL :: user.
+
+f) NEST1 user task{d} :
+     NEST2 particular prelude with DECS{c},
+       NEST2 user prelude with MODSETY{c},
+       NEST2 particular program{g} PACK, go on{94f} token,
+       NEST2 particualr poslude{i},
+       where (NEST2) is (NEST1 new DECS MODSETY STOP).
+
+10.6 Packets
+
+10.6.1 Syntax
+
+a) MOID NEST new MODSETY ALGOL68 stuffing packet{A7a} :
+     egg{94d} token, hole indication{56d}, is defined as{94d} token,
+       MOID NEST new MODSETY actual hole{56c}.
+
+{ b) Note that the rules for "MOID NEST new MODSETY LANGUAGE stuffing
+  packets" for other languages are not explicitly included in the
+  syntax.  These rules conceptually transform all such
+  LANGUAGE-stuffing-packets into ALGOL68-stuffing-packets with the
+  same meaning. }
+
+c) NEST new MODSETY1 MODS definition module packet of MODS{A7a} :
+     egg{94d} token, hole indication{56d}, is defined as{94d} token,
+       NEST new MODSETY1 MODS module declaration of MODS{49a},
+       where MODS absent from NEST{e}.
+d) new LAYER1 new DECS MODSETY1 MODS STOP
+       prelude packet of MODS{A7a} :
+     new LAYER1 new DECS MODSETY1 MODS STOP
+         module declaration of MODS{4a},
+       where MODS absent from new LAYER1{e}.
+e) WHETHER MODSETY MOD absent from NEST{c,d} :
+     WHETEHR MODSETY absent from NEST{e,f}
+             and MOD independent PROPSETY{71a,b,c},
+       where PROPSETY collected properties from NEST{g,h}.
+f) WHETHER EMPTY absent from NEST{e} :
+     WHETHER true.
+g) WHETHER PROPSETY1 PROPSETY2 collected properties from
+           NEST new PROPSETY2{e,g} :
+     WHETHER PROPSETY1 collected properties from NEST {g,h}.
+h) WHETHER EMPTY collected properties from new EMPTY{e,g} :
+     WHETHER true.
+
+i) *NEST new PROPSETY packet :
+     MOID NEST new PROPSETY LANGUAGE stuffing packet{a,b} ;
+     NEST new PROPSETY definition module packet of MODS{c} ;
+     NEST new PROPSETY particular program{A1g} ;
+     NEST new PROPSETY prelude packet of MODS{d}.
+j) *letter symbol : LETTER symbol{94a}.
+k) *digit symbol : DIGIT symbol{94b}.
+
+{ Examples:
+
+    a) EGG "abc" = ACCESS A,B (x := 1; y := 2; print (x+y))
+    c) EGG "abc" = MODULE A = DEF PUB REAL x FED
+    d) MODULE B = DEF PUB REAL y FED
+
+  The thre examples above would form a compatible collection of
+  packets when taken in conjunction with the particular-program BEGIN
+  NEST "abc" END }
+
+{ In rule a above, 'MODSETY' envelops the 'MOD's defined by al the
+  definition-module-packets that are being stuffed along with the
+  stuffing-packet.
+
+  In rules c and d, 'MODSETY1' need only envelop the 'MOD's for those
+  modules actually accessed from within that packet.
+
+  The semantics related to packets are only defined if, for a
+  collection of packets being stuffed together, all the 'MOD's
+  enveloped by the various 'MODSETY1's are enveloped by 'MODSETY'.  }
+
+{ A stuffing packet contains the definition of an actual-hole.  For
+  Algol 68 this consists on an enclosed-clause.  For other values of
+  the metanotion 'LANGUAGE' it is different, and it is expected to be
+  translated somehow to an equivalent Algol 68 definition,
+  conceptually naturally.
+
+  A definition module packet contains the definition of an actual-hole
+  which consists in one or more joined module declarations, with the
+  restriction that none of the declared modules shall exist in the
+  static environment at the formal-hole.
+
+  A prelude packet contains one or more joined module declarations.  }
+
+10.7 Compilation systems
+
+{ An implementtion of Algol 68 in which packets of a collection are
+  compiled into a collection of object-modules should conform to the
+  provisions of this section.  }
+
+10.7.1 Syntax
+
+{ Note that we use the notion "compilation unit" rather than the
+  original "compilation input" used in the IFIP modules definition.  }
+
+A) *LAYERS :: LAYER ; LAYERS LAYER.
+
+a) compilation unit :
+     MOID NEST new MODSETY LANGUAGE stuffing packet{A6a,b},
+       MOID NEST hole interface{d},
+       joined module interface with MODSETY{b,c} ;
+     NEST new MODSETY1 MODS definition module packet of MODS{A6c},
+       MOID NEST hole interface{d},
+       joined module interface with MODSETY1{b,c},
+       module interface with MODS{d} option ;
+     new LAYER1 new DECS MODSETY STOP particular program{A1g},
+       { void new LAYER1 new DECS STOP hole interface,}
+       unless (DECS) contains (MODULE),
+       joined module interface with MODSETY{b,c} ;
+     new LAYER1 new DECS MODSETY1 MODS STOP
+         prelude packet of MODS{A6d},
+       { void new LAYER1 new DECS STOP hole interface,}
+       unless (DECS) contains (module),
+       joined module interface with MODSETY1{b,c},
+       module interface with MODS{d} option.
+b) joined module interface with MODS MODSETY{a,b} :
+     module interface with MODS{d},
+       joined module interface with MODSETY{b,c}.
+c) joined module inteface with EMPTY{a,b} : EMPTY.
+
+{ A compilation-unit is either a stuffing packet, a definition module
+  packet, a particular program, or a prelude packet.  The packets
+  shall be accompanied by the required hole and module interface
+  information.  }
+
+{ d) Hyper-rules for "MOID NEST hole interface", "module interface
+     with MODS" and "MOID NEST object module".  The terminal
+     productions will most likely be in some cryptic notation
+     understood only by the compiler, i.e. the interface data. }
+
+{ The inclusion of the hypernotions "void new LAYER1 new DECS STOP
+  hole interface" within pragmatic remarks in rule a is intended to
+  signify that this information (which describes the standard
+  environment) must clearly be available to the compiler, but that it
+  may well not be provided in the form of an explicit
+  hole-interface. }
--- /dev/null
+++ b/src/gcc/algol68/lang-specs.h
@@ -0,0 +1,24 @@
+/* lang-specs.h -- gcc driver specs for Algol 68 frontend.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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.cc for the
+   Algol 68 language.  */
+
+{".a68", "@algol68", 0, 1, 0},
+  {"@algol68",
+   "a681 %i %(cc1_options) %{I*} %{L*} %D %{!fsyntax-only:%(invoke_as)}", 0, 1,
+   0},   
--- /dev/null
+++ b/src/gcc/algol68/lang.opt
@@ -0,0 +1,122 @@
+; Options for the Algol 68 front end.
+; Copyright (C) 2025 Free Software Foundation, Inc.
+;
+; 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/>.
+
+; See the GCC internals manual for a description of this file's format.
+
+; Please try to keep this file in ASCII collating order.
+
+; Describes command-line options used by this frontend
+
+Language
+Algol68
+
+I
+Algol68 Joined Separate
+; Documented in c-family/c.opt
+
+Wextensions
+Algol68 Warning Var(warn_algol68_extensions) LangEnabledBy(Algol68, Wextra)
+Warn for usage of non-portable extensions of Algol 68.
+
+Wvoiding
+Algol68 Warning Var(warn_algol68_voiding) LangEnabledBy(Algol68, Wextra)
+Warn when voiding occurs.
+
+Wextra
+Algol68 Warning
+; Documented in common.opt
+
+Wscope
+Algol68 Warning Var(warn_algol68_scope)
+Warn for potential name scope violations.
+
+Whidden-declarations
+Algol68 Warning Var(warn_algol68_hidden_declarations)
+Warn for hidden declarations in inner scopes.
+
+fa68-safe
+Algol68 Var(flag_a68_safe)
+-fa68-safe		Compile code only known to be memory safe.
+
+fa68-safe-bounds
+Algol68 Var(flag_a68_safe_bounds)
+-fa68-safe-bounds	Error out if not all bounds are known to be legal.
+
+fa68-brackets
+Algol68 Var(flag_a68_brackets)
+-fa68-brackets  	Consider [ .. ] and { .. } as being equivalent to ( .. ).
+
+fa68-debug
+Algol68 Var(flag_a68_debug)
+-fa68-debug     	Enable debugging traces of the Algol 68 front end.
+
+fa68-portcheck
+Algol68 Var(flag_a68_portcheck)
+-fa68-portcheck         Emit portability warnings.
+
+fa68-assert
+Algol68 Var(flag_a68_assert)
+Generate code for ASSERT constructs.
+
+fa68-nil-checking
+Algol68 Var(flag_a68_nil_checking)
+Generate code to perform NIL checking while dereferencing.
+
+fa68-bounds-checking
+Algol68 Var(flag_a68_bounds_checking)
+Generate code to perform run-time bounds checking on array accesses.
+
+fdump-algol68-modes
+Algol68 Var(flag_dump_algol68_modes)
+Dump Algol 68 modes after parsing.
+
+fdump-algol68-tree
+Algol68 Var(flag_dump_algol68_tree)
+Dump Algol 68 parse tree after parsing.
+
+static-libga68
+Driver
+Link the GNU Algol run-time library statically in the compilation.
+
+shared-libga68
+Driver
+Link the GNU Algol 68 run-time library dynamically in the compilation.
+
+std=algol68
+Algol68
+Conform to the Algol 68 Revised Report
+
+std=gnu68
+Algol68
+Accept GNU extensions to Algol 68
+
+; Stropping regimes.
+
+fstropping=
+Algol68 Joined RejectNegative Enum(stropping_regime) Var(flag_stropping_regime)
+-fstropping=[upper|supper]              Stropping regime to expect in Algol 68 programs.
+
+Enum
+Name(stropping_regime) Type(int) UnknownError(unknown stropping_regime setting %qs)
+
+EnumValue
+Enum(stropping_regime) String(upper) Value(0)
+
+EnumValue
+Enum(stropping_regime) String(supper) Value(1)
+
+; This comment is to ensure we retain the blank line above.
--- /dev/null
+++ b/src/gcc/algol68/lang.opt.urls
@@ -0,0 +1,41 @@
+; Autogenerated by regenerate-opt-urls.py from gcc/algol68/lang.opt and generated HTML
+
+I
+UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) LangUrlSuffix_Algol68(ga68/Directory-options.html#index-I)
+
+Wextensions
+LangUrlSuffix_Algol68(ga68/Warnings-options.html#index-Wextensions)
+
+Wvoiding
+LangUrlSuffix_Algol68(ga68/Warnings-options.html#index-Wno-voiding)
+
+Wextra
+UrlSuffix(gcc/Warning-Options.html#index-Wextra) LangUrlSuffix_D(gdc/Warnings.html#index-Wextra) LangUrlSuffix_Fortran(gfortran/Error-and-Warning-Options.html#index-Wextra)
+
+Wscope
+LangUrlSuffix_Algol68(ga68/Warnings-options.html#index-Wno-scope)
+
+Whidden-declarations
+LangUrlSuffix_Algol68(ga68/Warnings-options.html#index-Whidden-declarations)
+
+fa68-assert
+LangUrlSuffix_Algol68(ga68/Runtime-options.html#index-fa68-assert)
+
+fa68-nil-checking
+LangUrlSuffix_Algol68(ga68/Runtime-options.html#index-fa68-nil-checking)
+
+fa68-bounds-checking
+LangUrlSuffix_Algol68(ga68/Runtime-options.html#index-fa68-bounds-checking)
+
+fdump-algol68-modes
+LangUrlSuffix_Algol68(ga68/Developer-options.html#index-fdump-algol68-modes)
+
+fdump-algol68-tree
+LangUrlSuffix_Algol68(ga68/Developer-options.html#index-fdump-algol68-tree)
+
+static-libga68
+LangUrlSuffix_Algol68(ga68/Linking-options.html#index-static-libga68)
+
+shared-libga68
+LangUrlSuffix_Algol68(ga68/Linking-options.html#index-shared-libga68)
+
--- a/src/gcc/common.opt
+++ b/src/gcc/common.opt
@@ -3914,6 +3914,9 @@ Driver Joined
 static
 Driver
 
+static-libga68
+Driver
+
 static-libgcc
 Driver
 
--- a/src/gcc/common.opt.urls
+++ b/src/gcc/common.opt.urls
@@ -1895,6 +1895,9 @@ UrlSuffix(gcc/Overall-Options.html#index-specs)
 ;   duplicate: 'gcc/Darwin-Options.html#index-static-1'
 ;   duplicate: 'gcc/Link-Options.html#index-static'
 
+static-libga68
+LangUrlSuffix_Algol68(ga68/Linking-options.html#index-static-libga68)
+
 static-libgcc
 UrlSuffix(gcc/Link-Options.html#index-static-libgcc)
 
--- a/src/gcc/config.gcc
+++ b/src/gcc/config.gcc
@@ -93,6 +93,9 @@
 #  tm_rust_file		list of headers with definitions of target hook
 #			macros for the Rust compiler.
 #
+#  tm_algol68_file	list of headers with definitions of target hook
+#			macros for the Algol68 compiler.
+#
 #  out_file		The name of the machine description C support
 #			file, if different from "$cpu_type/$cpu_type.c".
 #
@@ -155,6 +158,9 @@
 #  rust_target_objs	List of extra target-dependent objects that be
 #			linked into the Rust compiler only.
 #
+#  algol68_target_objs	List of extra target-dependent objects that be
+#			linked into the Algol68 compiler only.
+#
 #  target_gtfiles       List of extra source files with type information.
 #
 #  xm_defines		List of macros to define when compiling for the
@@ -210,6 +216,10 @@
 #
 #  target_has_targetrustm	Set to yes or no depending on whether the target
 #			has its own definition of targetrustm.
+#
+#  target_has_targetalgol68m
+#			Set to yes or no depending on whether the target
+#			has its own deinition of targetdm.
 
 out_file=
 common_out_file=
@@ -228,10 +238,12 @@ cxx_target_objs=
 d_target_objs=
 fortran_target_objs=
 rust_target_objs=
+algol68_target_objs=
 target_has_targetcm=no
 target_has_targetm_common=yes
 target_has_targetdm=no
 target_has_targetrustm=no
+target_has_targetalgol68m=no
 tm_defines=
 xm_defines=
 # Set this to force installation and use of collect2.
@@ -621,6 +633,16 @@ then
 	rust_target_objs="${rust_target_objs} ${cpu_type}-rust.o"
 fi
 
+tm_algol68_file=
+if test -f ${srcdir}/config/${cpu_type}/${cpu_type}-algol68.h
+then
+	tm_algol68_file="${cpu_type}/${cpu_type}-algol68.h"
+fi
+if test -f ${srcdir}/config/${cpu_type}/${cpu_type}-algol68.cc
+then
+	algol68_target_objs="${algol68_target_objs} ${cpu_type}-algol68.o"
+fi
+
 extra_modes=
 if test -f ${srcdir}/config/${cpu_type}/${cpu_type}-modes.def
 then
@@ -790,9 +812,11 @@ case ${target} in
   d_target_objs="${d_target_objs} darwin-d.o"
   fortran_target_objs="darwin-f.o"
   rust_target_objs="${rust_target_objs} darwin-rust.o"
+  algol68_target_objs="${algol68_target_objs} darwin-algol68.o"
   target_has_targetcm=yes
   target_has_targetdm=yes
   target_has_targetrustm=yes
+  target_has_targetalgol68m=no
   extra_objs="${extra_objs} darwin.o"
   extra_gcc_objs="darwin-driver.o"
   default_use_cxa_atexit=yes
@@ -825,6 +849,8 @@ case ${target} in
   target_has_targetdm=yes
   rust_target_objs="${rust_target_objs} dragonfly-rust.o"
   target_has_targetrustm=yes
+  algol68_target_objs="${algol68_target_objs} dragonfly-algol68.o"
+  target_has_targetalgol68m=yes
   ;;
 *-*-freebsd*)
   # This is the generic ELF configuration of FreeBSD.  Later
@@ -878,12 +904,16 @@ case ${target} in
   target_has_targetdm=yes
   rust_target_objs="${rust_target_objs} freebsd-rust.o"
   target_has_targetrustm=yes
+  algol68_target_objs="${algol68_target_objs} freebsd-algol68.o"
+  target_has_targetalgol68m=yes
   ;;
 *-*-fuchsia*)
   native_system_header_dir=/include
   tmake_file="t-fuchsia"
   rust_target_objs="${rust_target_objs} fuchsia-rust.o"
   target_has_targetrustm=yes
+  algol68_target_objs="${algol68_target_objs} fuchsia-algol68.o"
+  target_has_targetalgol68m=yes
   ;;
 *-*-linux* | frv-*-*linux* | *-*-kfreebsd*-gnu | *-*-gnu* | *-*-kopensolaris*-gnu | *-*-uclinuxfdpiceabi)
   extra_options="$extra_options gnu-user.opt"
@@ -992,6 +1022,8 @@ case ${target} in
   esac
   rust_target_objs="${rust_target_objs} netbsd-rust.o"
   target_has_targetrustm=yes
+  algol68_target_objs="${algol68_target_objs} netbsd-algol68.o"
+  target_has_targetalgol68m=yes
   ;;
 *-*-openbsd*)
   tmake_file="t-openbsd"
@@ -1009,6 +1041,8 @@ case ${target} in
   target_has_targetdm=yes
   rust_target_objs="${rust_target_objs} openbsd-rust.o"
   target_has_targetrustm=yes
+  algol68_target_objs="${algol68_target_objs} openbsd-algol68.o"
+  target_has_targetalgol68m=yes
   ;;
 *-*-phoenix*)
   gas=yes
@@ -1071,6 +1105,8 @@ case ${target} in
   target_has_targetdm=yes
   rust_target_objs="${rust_target_objs} sol2-rust.o"
   target_has_targetrustm=yes
+  algol68_target_objs="${algol68_target_objs} sol2-algol68.o"
+  target_has_targetalgol68m=yes
   ;;
 *-*-*vms*)
   extra_options="${extra_options} vms/vms.opt"
@@ -1106,6 +1142,9 @@ case ${target} in
   rust_target_objs="${rust_target_objs} vxworks-rust.o"
   target_has_targetrustm=yes
 
+  algol68_target_objs="${algol68_target_objs} vxworks-algol68.o"
+  target_has_targetalgol68m=yes
+
   extra_gcc_objs="vxworks-driver.o"
 
   # This private header exposes a consistent interface for checks on
@@ -2232,6 +2271,8 @@ i[34567]86-*-mingw* | x86_64-*-mingw*)
 	target_has_targetdm="yes"
 	rust_target_objs="${rust_target_objs} winnt-rust.o"
 	target_has_targetrustm="yes"
+        algol68_target_objs="${algol68_target_objs} winnt-algol68.o"
+        target_has_targetalgol68m=yes
 	case ${target} in
 		x86_64-*-* | *-w64-*)
 			need_64bit_isa=yes
@@ -3702,6 +3743,10 @@ if [ "$target_has_targetrustm" = "no" ]; then
   rust_target_objs="$rust_target_objs default-rust.o"
 fi
 
+if [ "$target_has_targetalgol68" = "no" ]; then
+  algol68_target_objs="$algol68_target_objs default-algol68.o"
+fi
+
 # Support for --with-cpu and related options (and a few unrelated options,
 # too).
 case ${with_cpu} in
--- a/src/gcc/config/darwin.h
+++ b/src/gcc/config/darwin.h
@@ -507,6 +507,7 @@ extern GTY(()) int darwin_ms_struct;
    %{static|static-libgcc|static-libgcobol:%:replace-outfile(-lgcobol libgcobol.a%s)}\
    %{static|static-libgcc|static-libstdc++|static-libgfortran:%:replace-outfile(-lgomp libgomp.a%s)}\
    %{static|static-libgcc|static-libstdc++:%:replace-outfile(-lstdc++ libstdc++.a%s)}\
+   %{static|static-libga68:%:replace-outfile(-lga68 libga68.a%s)}\
    %{static|static-libgm2:%:replace-outfile(-lm2pim libm2pim.a%s)}\
    %{static|static-libgm2:%:replace-outfile(-lm2iso libm2iso.a%s)}\
    %{static|static-libgm2:%:replace-outfile(-lm2min libm2min.a%s)}\
--- a/src/gcc/config/rs6000/rs6000-logue.cc
+++ b/src/gcc/config/rs6000/rs6000-logue.cc
@@ -5332,18 +5332,18 @@ rs6000_output_function_epilogue (FILE *file)
       /* Tbtab format type.  Use format type 0.  */
       fputs ("\t.byte 0,", file);
 
-      /* Language type.  Unfortunately, there does not seem to be any
-	 official way to discover the language being compiled, so we
-	 use language_string.
-	 C is 0.  Fortran is 1.  Ada is 3.  Modula-2 is 8.  C++ is 9.
-	 Java is 13.  Objective-C is 14.  Objective-C++ isn't assigned
-	 a number, so for now use 9.  LTO, Go, D, and JIT aren't assigned
-	 numbers either, so for now use 0.  */
+      /* Language type.  Unfortunately, there does not seem to be any official
+	 way to discover the language being compiled, so we use
+	 language_string.  C is 0.  Fortran is 1.  Ada is 3.  Modula-2 is 8.
+	 C++ is 9.  Java is 13.  Objective-C is 14.  Objective-C++ isn't
+	 assigned a number, so for now use 9.  LTO, Go, D, Algol 68 and JIT
+	 aren't assigned numbers either, so for now use 0.  */
       if (lang_GNU_C ()
 	  || ! strcmp (language_string, "GNU GIMPLE")
 	  || ! strcmp (language_string, "GNU Go")
 	  || ! strcmp (language_string, "GNU D")
 	  || ! strcmp (language_string, "GNU Rust")
+	  || ! strcmp (language_string, "GNU Algol 68")
 	  || ! strcmp (language_string, "libgccjit"))
 	i = 0;
       else if (! strcmp (language_string, "GNU F77")
--- a/src/gcc/configure
+++ b/src/gcc/configure
@@ -649,6 +649,7 @@ ISLLIBS
 GMPINC
 GMPLIBS
 target_cpu_default
+algol68_target_objs
 rust_target_objs
 d_target_objs
 fortran_target_objs
@@ -658,6 +659,8 @@ use_gcc_stdint
 xm_defines
 xm_include_list
 xm_file_list
+tm_algol68_include_list
+tm_algol68_file_list
 tm_rust_include_list
 tm_rust_file_list
 tm_d_include_list
@@ -934,6 +937,7 @@ infodir
 docdir
 oldincludedir
 includedir
+runstatedir
 localstatedir
 sharedstatedir
 sysconfdir
@@ -1120,6 +1124,7 @@ datadir='${datarootdir}'
 sysconfdir='${prefix}/etc'
 sharedstatedir='${prefix}/com'
 localstatedir='${prefix}/var'
+runstatedir='${localstatedir}/run'
 includedir='${prefix}/include'
 oldincludedir='/usr/include'
 docdir='${datarootdir}/doc/${PACKAGE}'
@@ -1372,6 +1377,15 @@ do
   | -silent | --silent | --silen | --sile | --sil)
     silent=yes ;;
 
+  -runstatedir | --runstatedir | --runstatedi | --runstated \
+  | --runstate | --runstat | --runsta | --runst | --runs \
+  | --run | --ru | --r)
+    ac_prev=runstatedir ;;
+  -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \
+  | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \
+  | --run=* | --ru=* | --r=*)
+    runstatedir=$ac_optarg ;;
+
   -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
     ac_prev=sbindir ;;
   -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
@@ -1509,7 +1523,7 @@ fi
 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
+		libdir localedir mandir runstatedir
 do
   eval ac_val=\$$ac_var
   # Remove trailing slashes.
@@ -1662,6 +1676,7 @@ Fine tuning of the installation directories:
   --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]
+  --runstatedir=DIR       modifiable per-process data [LOCALSTATEDIR/run]
   --libdir=DIR            object code libraries [EPREFIX/lib]
   --includedir=DIR        C header files [PREFIX/include]
   --oldincludedir=DIR     C header files for non-gcc [/usr/include]
@@ -6253,7 +6268,7 @@ else
     We can't simply define LARGE_OFF_T to be 9223372036854775807,
     since some C++ compilers masquerading as C compilers
     incorrectly reject 9223372036854775807.  */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
+#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
   int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
 		       && LARGE_OFF_T % 2147483647 == 1)
 		      ? 1 : -1];
@@ -6299,7 +6314,7 @@ else
     We can't simply define LARGE_OFF_T to be 9223372036854775807,
     since some C++ compilers masquerading as C compilers
     incorrectly reject 9223372036854775807.  */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
+#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
   int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
 		       && LARGE_OFF_T % 2147483647 == 1)
 		      ? 1 : -1];
@@ -6323,7 +6338,7 @@ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
     We can't simply define LARGE_OFF_T to be 9223372036854775807,
     since some C++ compilers masquerading as C compilers
     incorrectly reject 9223372036854775807.  */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
+#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
   int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
 		       && LARGE_OFF_T % 2147483647 == 1)
 		      ? 1 : -1];
@@ -6368,7 +6383,7 @@ else
     We can't simply define LARGE_OFF_T to be 9223372036854775807,
     since some C++ compilers masquerading as C compilers
     incorrectly reject 9223372036854775807.  */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
+#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
   int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
 		       && LARGE_OFF_T % 2147483647 == 1)
 		      ? 1 : -1];
@@ -6392,7 +6407,7 @@ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
     We can't simply define LARGE_OFF_T to be 9223372036854775807,
     since some C++ compilers masquerading as C compilers
     incorrectly reject 9223372036854775807.  */
-#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62))
+#define LARGE_OFF_T ((((off_t) 1 << 31) << 31) - 1 + (((off_t) 1 << 31) << 31))
   int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721
 		       && LARGE_OFF_T % 2147483647 == 1)
 		      ? 1 : -1];
@@ -15149,6 +15164,17 @@ for f in $tm_rust_file; do
   esac
 done
 
+tm_algol68_file_list=
+tm_algol68_include_list=
+for f in $tm_algol68_file; do
+  case $f in
+    * )
+       tm_algol68_file_list="${tm_algol68_file_list} \$(srcdir)/config/$f"
+       tm_algol68_include_list="${tm_algol68_include_list} config/$f"
+       ;;
+  esac
+done
+
 xm_file_list=
 xm_include_list=
 for f in $xm_file; do
@@ -34096,6 +34122,9 @@ fi
 
 
 
+
+
+
 
 
 
--- a/src/gcc/configure.ac
+++ b/src/gcc/configure.ac
@@ -2472,6 +2472,17 @@ for f in $tm_rust_file; do
   esac
 done
 
+tm_algol68_file_list=
+tm_algol68_include_list=
+for f in $tm_algol68_file; do
+  case $f in
+    * )
+       tm_algol68_file_list="${tm_algol68_file_list} \$(srcdir)/config/$f"
+       tm_algol68_include_list="${tm_algol68_include_list} config/$f"
+       ;;
+  esac
+done
+
 xm_file_list=
 xm_include_list=
 for f in $xm_file; do
@@ -7562,6 +7573,8 @@ AC_SUBST(tm_d_file_list)
 AC_SUBST(tm_d_include_list)
 AC_SUBST(tm_rust_file_list)
 AC_SUBST(tm_rust_include_list)
+AC_SUBST(tm_algol68_file_list)
+AC_SUBST(tm_algol68_include_list)
 AC_SUBST(xm_file_list)
 AC_SUBST(xm_include_list)
 AC_SUBST(xm_defines)
@@ -7571,6 +7584,7 @@ AC_SUBST(cxx_target_objs)
 AC_SUBST(fortran_target_objs)
 AC_SUBST(d_target_objs)
 AC_SUBST(rust_target_objs)
+AC_SUBST(algol68_target_objs)
 AC_SUBST(target_cpu_default)
 
 AC_SUBST_FILE(language_hooks)
--- a/src/gcc/dwarf2out.cc
+++ b/src/gcc/dwarf2out.cc
@@ -25480,6 +25480,15 @@ gen_compile_unit_die (const char *filename)
 	  else if (strcmp (language_string, "GNU Rust") == 0)
 	    language = DW_LANG_Rust;
 	}
+      else if (!dwarf_strict)
+        {
+          /* XXX DW_LANG_Algol68 will be defined in DWARF 6? */
+          if (strcmp (language_string, "GNU Algol68") == 0)
+	    {
+	      language = DW_LANG_Algol68;
+	      lname = DW_LNAME_Algol68;
+	    }
+        }
     }
   /* Use a degraded Fortran setting in strict DWARF2 so is_fortran works.  */
   else if (startswith (language_string, "GNU Fortran"))
--- a/src/gcc/gcc.cc
+++ b/src/gcc/gcc.cc
@@ -4666,11 +4666,13 @@ driver_handle_option (struct gcc_options *opts,
     case OPT_static_libgfortran:
     case OPT_static_libquadmath:
     case OPT_static_libphobos:
+    case OPT_static_libga68:
     case OPT_static_libgm2:
     case OPT_static_libstdc__:
       /* These are always valid; gcc.cc itself understands the first two
 	 gfortranspec.cc understands -static-libgfortran,
 	 libgfortran.spec handles -static-libquadmath,
+	 a68spec.cc understands -static-libga68,
 	 d-spec.cc understands -static-libphobos,
 	 gm2spec.cc understands -static-libgm2,
 	 and g++spec.cc understands -static-libstdc++.  */
--- a/src/gcc/genhooks.cc
+++ b/src/gcc/genhooks.cc
@@ -36,6 +36,7 @@ static struct hook_desc hook_array[] = {
 #include "common/common-target.def"
 #include "d/d-target.def"
 #include "rust/rust-target.def"
+#include "algol68/algol68-target.def"
 #undef DEFHOOK
 };
 
--- a/src/gcc/regenerate-opt-urls.py
+++ b/src/gcc/regenerate-opt-urls.py
@@ -361,7 +361,8 @@ def write_url_file(index, optfile, dstfile):
 PER_LANGUAGE_OPTION_INDEXES = [
     ('gcc/Option-Index.html', None),
     ('gdc/Option-Index.html', 'D'),
-    ('gfortran/Option-Index.html', 'Fortran')
+    ('gfortran/Option-Index.html', 'Fortran'),
+    ('ga68/Option-Index.html', 'Algol68'),
 ]
 
 def main(args):
--- /dev/null
+++ b/src/gcc/testsuite/algol68/README.mcts
@@ -0,0 +1,37 @@
+The tests in compile/mcts and execute/mcts have been adapted from:
+
+  The Revised MC Algol 68 Test Set, version 3
+
+edited by Dick Grüne in 1973 and originally published by the
+Mathematisch Centrum in Amsterdam, a non-profit institution founded in
+1946 aiming at the promotion of pure mathematics and its applications.
+
+The WG 2.1 blessed the test set with this authorized statement:
+
+  "This ALGOL68 Test Set has been reviewed by the IFIP Working Group
+   2.1, which considers it as a valuable means of testing
+   implementations of ALGOL68."
+
+The test set explores all odd corners of Algol 68.
+
+The tests have been modified in order to accommodate the GNU Algol 68
+implementation.  Some general adaptations are:
+
+- Many tests in the original MC test set print out expected results so
+  they can be verified visually.  We check for them programmatically
+  instead making use of the ASSERT construct.
+
+Additional particular modifications are explained and justified in the
+source files of the corresponding tests.
+
+The tests fall in the following categories:
+
+Null programs (nullNN.a68)
+  Various forms of empty enclosed-clauses.
+
+Simple tests (simpNN.a68)
+  Contains almost all language features of the language used in
+  simple ways.
+
+Declarers tests (declNN.a68)
+  Declarers and their well-formedness.
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/a68includes/goodbye-supper.a68
@@ -0,0 +1,4 @@
+proc goodbye = (string name) string:
+begin string msg := "Goodbye " + name;
+      msg
+end;
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/a68includes/goodbye.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# PR UPPER PR #
+
+PROC goodbye = (STRING name) STRING:
+BEGIN
+    STRING msg := "Goodbye " + name;
+    msg
+END;
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/a68includes/hello-supper.a68
@@ -0,0 +1,5 @@
+proc hello = (string name) string:
+begin string msg := "Hello " + name;
+      msg
+end;
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/a68includes/hello.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# PR UPPER PR #
+
+PROC hello = (STRING name) STRING:
+BEGIN
+    STRING msg := "Hello " + name;
+    msg
+END;
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/actual-bounds-expected-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT a := (1,2,3); # { dg-error "actual bounds expected" }  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/actual-bounds-expected-2.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN LOC[]INT a := (1,2,3); # { dg-error "actual bounds expected" }  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/actual-bounds-expected-3.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN LOC[]INT a := (1,2,3), # { dg-error "actual bounds expected" }  #
+               b := (4);
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/bold-nestable-comment-1.a68
@@ -0,0 +1,7 @@
+# { dg-options {-fstropping=upper} }  #
+# pr UPPER pr  #
+BEGIN NOTE This is a
+           NOTE nestable ETON comment in bold style.
+      ETON
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/bold-taggle-1.a68
@@ -0,0 +1,6 @@
+# { dg-options {-std=gnu68 -fstropping=upper} }  #
+
+BEGIN MODE FOO_BAR = INT;
+      FOO_BAR foo_bar = 10;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/brief-nestable-comment-1.a68
@@ -0,0 +1,4 @@
+begin { This is a
+        { nestable } comment in brief style.  }
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/brief-nestable-comment-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN NOTE This is a
+        { nestable } comment in brief style.
+      ETON
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/char-break-1.a68
@@ -0,0 +1,11 @@
+{ Make sure char denotations with string breaks work.  }
+begin prio % = 9;
+      op % = (char a) char: a;
+      assert (ABS %"'n" = 10);
+      assert (ABS %"'f" = 12);
+      assert (ABS %"'t" = 9);
+      assert (ABS %"'r" = 13);
+      assert (%"'(  u0061)" = "a");
+      assert (%"'(U00000061  )" = "a");
+      assert (%"'(u1234)" = invalid_char)
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/compile.exp
@@ -0,0 +1,34 @@
+# Copyright (C) 2024 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/>.
+
+# Compile tests, no torture testing.
+#
+# These tests raise errors in the front end; torture testing doesn't apply.
+
+load_lib algol68-dg.exp
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+set saved-dg-do-what-default ${dg-do-what-default}
+
+set dg-do-what-default "compile"
+algol68-dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.a68]] "" ""
+set dg-do-what-default ${saved-dg-do-what-default}
+
+# All done.
+dg-finish
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/conditional-clause-1.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN INT i := 26;
+      IF INT ii = i * 2; ii > 50 THEN
+         ii
+      ELIF i = 10 THEN
+         100
+      FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-bold-taggle-1.a68
@@ -0,0 +1,6 @@
+# { dg-options {-std=algol68 -fstropping=upper} }  #
+
+BEGIN MODE FOO_BAR = INT; # { dg-error "unworthy" }  #
+      FOO_BAR foo_bar = 10;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-coercion-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN INT a;
+      a := "foo" # { dg-error "cannot be coerced" } #
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-coercion-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+# This is Example 4.2.6c in McGETTRICK[78].  #
+BEGIN []STRUCT([]INT a) r = (1,2,3); # { dg-error "cannot be coerced" } #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-coercion-flex-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Coercing from REF FLEX[]REAL to REF[]REAL is not allowed, since
+  flexibility shall match #
+BEGIN FLEX[1:0] REAL rowvar := SKIP;
+      REF [] REAL xlm = rowvar; # { dg-error "FLEX.*cannot be coerced" }  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-conformance-clause-1.a68
@@ -0,0 +1,8 @@
+{ This is an invalid program.  }
+begin case
+           if true then "foo" else 10 fi { dg-error "not a united mode" }
+      in (string): skip,
+         (int): skip
+      esac
+end
+   
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-contraction-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Contracting mixed collateral variable and constant declarations is
+  not allowed.
+#
+(INT foo = 100, bar := 200) # { dg-error "mixed" } #
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-contraction-2.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Contracting mixed collateral variable and constant declarations is
+  not allowed.  #
+BEGIN PROC x = VOID: SKIP,
+      y := VOID: SKIP; # { dg-error "mixed" } #
+      x
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-incestuous-union-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Union modes shall not contain modes which are firmly related, i.e.
+  it shall not be possible to coerce from one mode to another in a
+  firm context. #
+BEGIN UNION(INT, REF INT) incestuous; # { dg-error "has firmly related components" } #
+      incestuous
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-label-after-decl-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN GOTO end;
+      ASSERT(FALSE);
+end:  0;
+      INT i = 10; # { dg-error "declaration cannot follow" }  #
+      i
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-nestable-comments-1.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" } #
+# pr UPPER pr  #
+BEGIN NOTE This is a
+        NOTE nestable ETON comment in brief style.
+      ETON
+      { Another { comment }.  }
+      NOTE invalid { nesting ETON of comments } # { dg-error "" }  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-nested-comment-1.a68
@@ -0,0 +1,6 @@
+{ The string in nested comment is in one logical line.  }
+begin
+      { puts ("{'n { dg-error {} }
+"); { this prints foo }}
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-no-bounds-allowed-1.a68
@@ -0,0 +1,15 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN [1:10]INT i,
+      [1:10]STRUCT(REF[]INT i, BOOL j) k,
+      [1:10]STRUCT([1:10]INT i, BOOL j) l,
+      [1:10]REF[]INT p;
+      # formal, so no bounds allowed:  #
+      [1:10]PROC[1:10]INT q, # { dg-error "formal bounds expected" }  #
+      STRUCT(REF[1:10]INT i, BOOLj) m, # { dg-error "virtual bounds expected" }  #
+      [1:10]REF[1:10]INT mn, # { dg-error "virtual bounds expected" }  #
+      PROC([1:10]INT)VOID pp, # { dg-error "formal bounds expected" }  #
+      UNION([1:10] INT, BOOL) nm, # { dg-error "formal bounds expected" }  #
+      [1:10]INT u = (1); # { dg-error "formal bounds expected" }  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-string-break-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN puts ("hello '_ world") # { dg-error "invalid string break sequence" }  #
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-string-break-2.a68
@@ -0,0 +1,2 @@
+begin puts ("hello '(U0000) world") # { dg-error "eight" }  #
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-string-break-3.a68
@@ -0,0 +1,2 @@
+begin puts ("hello '(u00) world") # { dg-error "four" }  #
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-string-break-4.a68
@@ -0,0 +1,2 @@
+begin puts ("hello '(u) world") # { dg-error "four" }  #
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-string-break-5.a68
@@ -0,0 +1,2 @@
+begin puts ("hello '(u0010u0020) world") # { dg-error "" }  #
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-string-break-6.a68
@@ -0,0 +1,2 @@
+begin puts ("hello '(u0010'/) world") # { dg-error "" }  #
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-string-break-7.a68
@@ -0,0 +1,2 @@
+begin puts ("'") # { dg-error "" }  #
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-supper-1.a68
@@ -0,0 +1,3 @@
+# { dg-options {-fstropping=upper} }  #
+
+begin ~ end # { dg-error "" }  #
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-supper-2.a68
@@ -0,0 +1,5 @@
+# { dg-options {-fstropping=supper} }  #
+
+begin int foo__bar = 10; # { dg-error "unworthy" }  #
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-supper-3.a68
@@ -0,0 +1,5 @@
+# { dg-options {-fstropping=supper} }  #
+
+begin int _bar = 10; # { dg-error "unworthy" }  #
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-supper-4.a68
@@ -0,0 +1,5 @@
+{ dg-options {-fstropping=supper} }
+
+begin int foo bar = 10; { dg-error "" }
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-supper-5.a68
@@ -0,0 +1,5 @@
+# { dg-options {-fstropping=supper} }  #
+
+begin int foo__ = 10; # { dg-error "unworthy" }  #
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-supper-6.a68
@@ -0,0 +1,6 @@
+# { dg-options {-fstropping=supper} }  #
+
+begin mode foo_Invalid = int; # { dg-error "Invalid" }  #
+      foo_Invalid some_int = 10; # { dg-error "Invalid" }  #
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-underscore-in-mode-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Underscores are unworthy characters if they are not trailing
+  either a taggle or, in UPPER stropping, a bold word.  #
+BEGIN INT invalid_tag__; # { dg-error "unworthy character" } #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-underscore-in-tag-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Underscores are unworthy characters if they are not trailing a
+  taggle or, in UPPER stropping, a bold word..  #
+BEGIN MODE INVALID_BOLD_WORD__; # { dg-error "unworthy character" } #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-upper-1.a68
@@ -0,0 +1,3 @@
+# { dg-options {-fstropping=supper} }  #
+
+BEGIN ~ END # { dg-error "" }  #
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-widening-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN INT a := 10;
+      LONG REAL l := a; # { dg-error "coerced" } #
+      l
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-widening-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN INT a := 10;
+      LONG INT l := a; # { dg-error "coerced" } #
+      l
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-widening-3.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN INT d := 0;
+      INT y := 10;
+      LONG REAL x;
+      2
+        + (d > 0 | x | # { dg-error "" }  #
+           y
+          )
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-widening-4.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN
+   INT d := 0;
+   LONG REAL x;
+   2
+     + (d > 0 | x | # { dg-error "" }  #
+          10
+       )
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-widening-5.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN
+   LONG INT d := 0; # { dg-error "coerced" }  #
+   d
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-widening-6.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN
+   LONG LONG INT d := LONG 0; # { dg-error "coerced" }  #
+   d
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-widening-7.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN
+   LONG REAL d := 3.14; # { dg-error "coerced" }  #
+   d
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-widening-8.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN
+   LONG LONG REAL d := LONG 3.14; # { dg-error "coerced" }  #
+   d
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/error-widening-9.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN
+   INT d := 0;
+   LONG LONG REAL x;
+   2
+     + (d > 0 | x | # { dg-error "" }  #
+          10
+       )
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/hidden-operators-1.a68
@@ -0,0 +1,11 @@
+{ dg-options {-Whidden-declarations} }
+
+begin mode Trilean = union (void,bool);
+
+      Trilean unknown = empty;
+      op NOT = (Trilean a) Trilean: { dg-warning "hides" }
+         skip;
+      op AND = (Trilean a,b) Trilean: { dg-warning "hides" }
+         skip;
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/implicit-widening-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-Wextensions -fstropping=upper" }  #
+
+# This program shall compile without warning, because
+  widening from INT to REAL is legal in the strict language,
+  since they have the same size.  #
+
+BEGIN BOOL cond;
+      REAL x, y;
+      y + (cond | x | 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/include-supper.a68
@@ -0,0 +1,16 @@
+{ dg-options "-I$srcdir/algol68/compile/a68includes" }
+{ dg-additional-files "$srcdir/algol68/compile/a68includes/hello-supper.a68 $srcdir/algol68/compile/a68includes/goodbye-supper.a68" }
+
+begin string name := "Algol68 with supper!";
+      { Both files are in `./a68includes'.
+        The first one will be included because we uwed `-I.
+        The second one will be included because of the relative path. }
+      pr include "hello-supper.a68" pr
+      pr include "a68includes/goodbye-supper.a68" pr
+
+      string bye := goodbye(name);
+      string hi := hello(name);
+
+      puts(hi + "\n");
+      puts(bye  + "\n")
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/include.a68
@@ -0,0 +1,19 @@
+# { dg-options "-I$srcdir/algol68/compile/a68includes -fstropping=upper" } #
+# { dg-additional-files "$srcdir/algol68/compile/a68includes/hello.a68 $srcdir/algol68/compile/a68includes/goodbye.a68" } #
+
+# PR UPPER PR  #
+
+BEGIN STRING name := "Algol68!";
+      # Both files are in `./a68includes'.
+        The first one will be included because we used `-I'.
+        The second one will be included because of the relative path.
+      #
+      PR include "hello.a68" PR
+      PR include "a68includes/goodbye.a68" PR
+
+      STRING bye := goodbye(name);
+      STRING hi := hello(name);
+
+      puts(hi + "\n");
+      puts(bye  + "\n")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/labeled-unit-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+
+# This tests that the mode of the value yielded by a labeled unit is
+  the mode of the unit.  #
+BEGIN 10;
+jorl: 20
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcgt-1.3b.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN REAL r := 10.0, circum, area;
+      circum := 2 * pi * r; area := pi * r * r
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcgt-7.1.3a-bis.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Transient references and declarations.  #
+BEGIN FLEX[4,6]INT p;
+      # Illegal, cannot remember transient name.  #
+      REF[]INT q2 = p[3,]; # { dg-error "" }  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcgt-7.1.3a.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Transient references and declarations.  #
+BEGIN FLEX[4,6]INT p;
+      # Illegal.  p cannot be deflexed since it is a REF FLEX.  #
+      REF[,]INT q3 = p; # { dg-error "" }  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcts/compile.exp
@@ -0,0 +1,34 @@
+# Copyright (C) 2024 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/>.
+
+# Compile tests, no torture testing.
+#
+# These tests raise errors in the front end; torture testing doesn't apply.
+
+load_lib algol68-dg.exp
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+set saved-dg-do-what-default ${dg-do-what-default}
+
+set dg-do-what-default "compile"
+algol68-dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.a68]] "" ""
+set dg-do-what-default ${saved-dg-do-what-default}
+
+# All done.
+dg-finish
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcts/decl06.a68
@@ -0,0 +1,258 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN # 1. Actual declaration.  #
+      # 1.a Without bounds.  #
+
+      # primitive  #
+      BEGIN INT x1,
+            INT x2, x3,
+            INT x4, x5, x6,
+            REAL x7, x8, x9, x10, x11, x12,
+            LONG INT x13,
+            LONG REAL x14,
+            BOOL x15,
+            CHAR x16;
+            SKIP
+      END;
+
+      # ref + primitive  #
+      BEGIN REF INT x1,
+            REF REF REF REAL x2,
+            REF REF REF REF LONG REAL x3,
+            REF REF REF REF REF BOOL x4,
+            REF REF REF REF REF REF CHAR x5,
+            REF REF PROC VOID x6;
+            SKIP
+      END;
+
+      # proc  #
+      BEGIN PROC VOID x1,
+            PROC PROC REAL x2,
+            PROC PROC PROC PROC LONG REAL x3,
+            PROC PROC PROC PROC PROC BOOL x4,
+            PROC PROC PROC PROC PROC PROC CHAR x5,
+            PROC PROC PROC VOID x6;
+            SKIP
+      END;
+
+      # ref + proc  #
+      BEGIN REF REF REF REF REF REF PROC VOID x1,
+            PROC REF REAL x2,
+            PROC REF PROC REF LONG REAL x3,
+            PROC REF PROC REF PROC BOOL x4,
+            REF PROC REF PROC REF PROC CHAR x5,
+            PROC REF PROC VOID x6;
+            SKIP
+      END;
+
+      # proc with one parameter which is primitive or ref + primitive  #
+      BEGIN PROC(INT)VOID x1,
+            PROC(REF REF REF LONG INT)VOID x2,
+            PROC(BOOL)VOID x3,
+            PROC(REF CHAR)VOID x4,
+            PROC(LONG REAL)VOID x5,
+            PROC(REF REF REF BOOL)VOID x6,
+            PROC(PROC VOID)VOID x7,
+            PROC(REF REF PROC VOID)VOID x8;
+            SKIP
+      END;
+
+      # ref + proc with one parameter which is primitive or ref + primitive  #
+      BEGIN REF PROC(INT)VOID x1,
+            REF REF PROC(LONG REAL)VOID x2, x3,
+            REF REF REF REF PROC(REF CHAR)VOID x4,
+            REF PROC(PROC VOID)VOID x5,
+            REF REF PROC(REF PROC VOID)VOID x6;
+            SKIP
+      END;
+
+      # ref * proc with more than one parameter which are ref * primitive  #
+      BEGIN PROC(INT,LONG INT)VOID x1,
+            PROC(REAL,REF LONG REAL,REF REF BOOL)VOID x2,
+            PROC(REF REF REF CHAR,INT,LONG INT,REAL,REAL,INT)VOID x3,
+            REF PROC(INT,INT,INT,REF CHAR)VOID x4,
+            REF REF REF PROC(PROC VOID,REF REF PROC VOID,INT)VOID x5;
+            SKIP
+      END;
+
+      # ref + row of * ref * primitive  #
+      BEGIN REF[]INT x1,
+            REF[,]REAL x2,
+            REF REF[,,,]LONG REAL x3,
+            REF REF REF[,,,,,]REF BOOL x4,
+            REF[]REF REF REF LONG INT x5,
+            REF REF[,,,,]REF REF CHAR x6,
+            REF[]PROC VOID x7,
+            REF[,]REF REF PROC VOID x8;
+            SKIP
+      END;
+
+      # ref + row of * ref * proc  #
+      BEGIN REF[] PROC VOID x1,
+            REF REF[,] PROC(REF INT)VOID x2,
+            REF REF REF[]PROC(INT, REF REF INT)VOID x3,
+            REF[]REF PROC(REF LONG REAL, REF REF REF CHAR, REF LONG LONG REAL)VOID x4,
+            REF REF[,,,]REF REF REF PROC(REF INT, LONG LONG LONG INT)VOID x5;
+            REF[]PROC(PROC VOID,REF PROC VOID)VOID x6;
+            SKIP
+      END;
+
+      # ref * proc with row of parameters  #
+      BEGIN PROC([]REAL)VOID x1,
+            REF PROC(INT, []LONG REAL)VOID x2,
+            REF REF PROC([,]INT, []REF REF BOOL)VOID x3,
+            REF REF REF REF PROC(REF[]INT, REF REF[]REF REF LONG REAL)VOID x4,
+            PROC(REF REF[,,,]REF REF REF REAL)VOID x5,
+            PROC([]REF REAL, [,,,]REF CHAR, REF[,]BOOL)VOID x6,
+            PROC([]REF PROC VOID, REF[,,]PROC VOID, REF REF[,]REF REF PROC VOID)VOID x7;
+            SKIP
+      END;
+
+      # nested rows  #
+      BEGIN REF[,,,]REF[,]INT x1,
+            REF[]REF[]PROC VOID x2,
+            REF[]REF REF[]REF BOOL x3,
+            REF[,,,]REF[,,,]REF REF REF PROC VOID x4,
+            REF REF[]REF[]INT x5,
+            REF[]REF[]REF[]REF[]REF[]LONG REAL x6;
+            SKIP
+      END;
+
+      # nested procs  #
+      BEGIN PROC(PROC(PROC (PROC VOID)VOID)VOID)VOID x1,
+            PROC(INT,
+                 PROC(REF REF PROC VOID,
+                      REAL,
+                      REF PROC(REF LONG INT, PROC VOID)VOID,
+                      INT) VOID)VOID x2,
+            PROC(INT,
+                 PROC VOID,
+                 PROC (INT,
+                       PROC VOID,
+                       REF REAL,
+                       REF PROC VOID)VOID)VOID x3,
+            PROC(INT,
+                 PROC (INT,INT) VOID,
+                 PROC (INT) VOID,
+                 REAL)VOID x4;
+            SKIP
+      END;
+
+      # mixed rows and procs  #
+      BEGIN REF[]PROC([,]INT,PROC([]PROC VOID) VOID,
+                      [,] PROC(PROC VOID, INT) VOID,
+                      REF[]PROC VOID)VOID x1;
+            SKIP
+      END;
+
+      # 1.b. With bounds.  #
+      BEGIN [1:1]INT x1,
+            [1:1,1:1]REF LONG REAL x2,
+            [1:1,1:1,1:1]REF REF PROC VOID x3,
+            [1:1]PROC VOID x4,
+            [1:1]PROC(INT)VOID x5,
+            [1:1]PROC(INT,REAL,REF PROC VOID)VOID x6,
+            [1:1,1:1,1:1,1:1]REF REF PROC(INT)VOID x7,
+            [1:1]REF[]INT x8,
+            [1:1]REF[,,,]REF PROC VOID x9,
+            [1:1]REF PROC([]INT)VOID x10,
+            [1:1]PROC([]REF PROC VOID, REF[,,]PROC VOID,
+                      REF REF REF REF[,]REF REF REF PROC VOID)VOID x11,
+            [1:1]REF[]REF[,,]REF REF[]LONG REAL x12,
+            [1:1]PROC(REF[]PROC VOID, []PROC VOID, []REF INT)VOID x13;
+            SKIP
+      END;
+
+      # 2. Variable and constant declarations.  #
+
+      BEGIN PROC VOID a; PROC(INT)VOID b;
+            PROC VOID c, d; REAL e; REAL f, g;
+            SKIP; SKIP; SKIP; SKIP
+      END;
+
+      # 3. Declarations of routines.  #
+
+      BEGIN INT i;
+            PROC a = VOID: SKIP;
+            PROC(INT)VOID b = (INT c) VOID: SKIP;
+            PROC(INT,REAL)VOID c = (INT e, REAL f) VOID: SKIP;
+            BEGIN PROC c = VOID: a; # no error  # SKIP END
+      END;
+
+      # 4. Call without parameters.  #
+
+      BEGIN PROC VOID a = VOID: SKIP;
+            PROC VOID b := a;
+            REF PROC VOID c := b;
+            REF REF PROC VOID d = c;
+
+            a; # without deref  #
+            b; # with deref  #
+            c; # with deref  #
+            d; # with deref  #
+
+            SKIP
+      END;
+
+      # 5. Call with parameters.  #
+      BEGIN INT int; REAL real;
+            PROC(INT)VOID dcs1,
+            PROC(INT,REAL)VOID dcs2;
+            PROC(INT)VOID a = (INT a) VOID: SKIP;
+            PROC(INT)VOID b;
+            REF PROC(INT)VOID c = b;
+            REF PROC(INT)VOID d;
+            PROC(INT,REAL)VOID e = (INT a, REAL b) VOID: SKIP;
+
+            a (int);
+            dcs1 (int);
+            dcs2 (int, real);
+            e (int, real);
+            b (int);
+            c (int);
+            d (int);
+            BEGIN REF REF REF REF REF REF REF REF REF REF
+                  REF REF REF REF REF REF REF REF REF REF
+                  PROC(INT)VOID a; a (int); SKIP
+            END;
+            BEGIN # No error  #
+               PROC(REF INT, REF REAL)VOID a;
+               a (int, real)
+            END;
+
+            BEGIN PROC(INT)VOID a; a (int) END;
+            BEGIN PROC(INT)VOID a; a (int); SKIP END
+      END;
+
+      # 6. Assignation with an identifier as destination.  #
+
+      BEGIN INT a; REF INT b = a; PROC(REAL)REAL c;
+            a := 1;
+            b := a;
+         CO   c := sin; XXX CO
+            SKIP
+      END;
+
+      # 7. Assignation with a slice as destination.  #
+
+      BEGIN INT i, j, k, l;
+            [i:i]REAL a1;
+            [i:i,j:j]REAL a2;
+            REF[]REAL a3 = a1;
+            REF[,]REAL a4;
+            REF[,,]REAL a5 = a4;
+            [,,,]REF REAL a6 = a3[i];
+
+            a1[i] := 3;
+            a2[i,j] := 3;
+            a3[i] := 3;
+            a4[i,j] := 3;
+            a5[i,j,k] := 3;
+            a6[i,j,k,l] := 3;
+            BEGIN REF REF REF REF REF REF REF REF REF REF
+                  REF REF REF REF REF REF REF REF REF REF
+                  []REAL x;
+                  x[i] := 3.0
+            END
+      END
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcts/idef10.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN INT count := 0;
+      FOR i FROM 1 BY i DO count +:= 1 OD; # { dg-error "" }  #
+      ASSERT (count = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcts/mdeq01.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Mode equivalencing.  #
+BEGIN MODE N = UNION(STRUCT(REAL re, im), COMPL); # { dg-error "" }  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcts/mdeq03.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Mode equivalencing.  #
+BEGIN MODE M = PROC(M)M,
+           N = PROC(N)N,
+           O = UNION(N,M); # { dg-error "" }  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcts/mdeq05.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Mode equivalencing.  #
+BEGIN MODE N = UNION (BYTES, BITS, REF BITS); # { dg-error "" }  #
+      MODE SZEREDI = UNION (INT,REAL,REF UNION (INT, REAL)); # { dg-error "" }  #
+      # Szeredi - ambiguity.  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcts/mdeq06.a68
@@ -0,0 +1,18 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Some equivalencing.  #
+BEGIN MODE A = STRUCT (REF A l, REF A r),
+           B = STRUCT (REF B l, REF B r),
+           C = STRUCT (REF D l, REF E r),
+           D = STRUCT (REF E l, REF C r),
+           E = STRUCT (REF C l, REF D r),
+           F = STRUCT (REF STRUCT (REF A l, REF B r) l,
+                       REF STRUCT (REF STRUCT (REF C l, REF D r) l,
+                                   REF STRUCT (REF E l, REF F r) r
+                                  ) r
+                      );
+
+      # error - all modes are the same  #
+      MODE M = UNION (A,B,C,D,E,F); # { dg-error "" }  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcts/oper05.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Operator test, mutual recursion.  #
+BEGIN PRIO +>=1, +<=1;
+      OP +> = (INT a, b) INT: a+<b;
+      OP +< = (INT a, b) INT: a+>b;
+      1+>2
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcts/oper06.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN OP + = (REAL a, b) REAL: a - b; # { dg-error "" } #
+      OP + = (REF REAL a, b) REAL: a - b; # { dg-error "" } #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcts/oper12.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Operator test, illegal operator.  #
+BEGIN OP   += = (INT a) INT: -a;
+      OP  +:= = (INT a) INT: -a;
+      OP -/:= = (INT a) INT: -a;
+      OP +==: = (INT a) INT: -a;
+
+      # Correct version.  #
+      +=+:=-/:=+==:+==:+=+:=+==:1;
+      # Bad version.  #
+      +=+:=-/:=+==:+==+=+:=+==:=1 # { dg-error "" }  #
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/mcts/oper15.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Incorrect, since not all declarers are of the mode row-of  #
+BEGIN UPB UNION ([]INT,BOOL) ([]INT (1)); # { dg-error "" }  #
+      LWB UNION (REF[,]STRING,STRING) ("ab"); # { dg-error "" }  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/nested-comment-1.a68
@@ -0,0 +1,4 @@
+{ Comment delimiters within strings get ignored.  }
+begin { puts { ("{""'n"); } }
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/nested-comment-2.a68
@@ -0,0 +1,6 @@
+{ The string in nested comment is in one logical line.  }
+begin
+      { puts ("{'n\
+"); { this prints foo }}
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/operators-firmly-related.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN PRIO MIN = 6;
+      OP MIN = (REF REAL a, b) REF REAL: (a < b | a | b), # { dg-error "firmly related" }  #
+         MIN = (REAL a, b) REAL: (a < b | a | b); # { dg-error "firmly related" }  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/recursive-modes-1.a68
@@ -0,0 +1,33 @@
+# { dg-options "-fstropping=upper" }  #
+
+# This program triggered a bug related to incomplete modes.  #
+BEGIN MODE REC_MSET = STRUCT (REF REC_MSET_ELM head, tail,
+                              INT num elems,
+                              PROC(REC_MSET_DATA)BOOL gate),
+           REC_MSET_ELM = STRUCT (REC_MSET_DATA data, BOOL mark, REF REC_MSET_ELM next),
+           REC_MSET_DATA = UNION (REC_RSET,REC_RECORD,REC_FIELD,REC_CMNT),
+           REC_RSET = STRUCT (REC_MSET mset,
+                              INT min size, max size,
+                              REF REC_RECORD descriptor),
+           REC_RECORD = STRUCT (REC_LOC loc, REC_MSET mset, INT foo),
+           REC_CMNT = STRUCT (REC_LOC loc, STRING content),
+           REC_FIELD = STRUCT (REC_LOC loc, STRING name, value),
+           REC_LOC = STRUCT (STRING source, INT line, char);
+
+      PROC rec loc unknown = REC_LOC:
+         ("unknown", 0, 0);
+      PROC rec record gate = (REC_MSET_DATA d) BOOL:
+         (d | (REC_FIELD): TRUE, (REC_CMNT): TRUE | FALSE);
+      REF REC_MSET_ELM rec no mset elm = NIL;
+      
+      PROC rec mset new = (PROC(REC_MSET_DATA)BOOL gate) REC_MSET:
+         (HEAP REC_MSET := (rec no mset elm, rec no mset elm,
+                            0, gate));
+
+      REF REC_RECORD rec no record = NIL;
+
+      PROC rec record new = REF REC_RECORD:
+         HEAP REC_RECORD := (rec loc unknown, rec mset new (rec record gate), 0);
+      
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/serial-clause-jump-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+
+# This is an infinite loop, but it should compile just fine an yield
+  an integer after infinite time.  #
+
+BEGIN foo: foo
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/snobol.a68
@@ -0,0 +1,1100 @@
+# { dg-options "-fstropping=upper" }  #
+
+# This is Frank Pagan's SNOBOL4 Interpreter in ALGOL 68 (1976),
+  fetched from Dick Grune's page https://dickgrune.com/CS/Algol68/
+
+  The interpreter described in "Algol 68 as an Implementation Language\
+  for Portable Interpreters", ACM SIGPLAN Notices - Proceedings of the
+  Strathclyde ALGOL 68 conference, Volume 12 Issue 6, June 1977,
+  pp. 54 - 62, and "A Highly-Structured Interpreter for a SNOBOL4
+  Subset", Software: Practice and Experience, Vol. 9, 4,
+  pp. 281-312, April 1979.
+
+  Modifications by Jose E. Marchesi:
+  - Use the simple POSIX-like transput provided by GCC.
+  - Read programs from lines rather than from cards.
+  - Add command-line option -l (listing).
+#
+
+BEGIN PROC itoa = (INT i) STRING:
+      BEGIN IF i = 0
+            THEN "0"
+            ELSE INT n := ABS i;
+                 STRING res;
+                 WHILE n /= 0
+                 DO INT rem = n %* 10;
+                    res := REPR (rem > 9 | (rem - 10) + ABS "a" | rem + ABS "0") + res;
+                    n %:= 10
+                 OD;
+                 (i < 0 | "-" + res | res)
+            FI
+      END;
+
+      CHAR sharp = REPR 35; # Sharp character,
+                              to avoid confusing Emacs.  #
+
+      # Input file.  #
+      INT filein;
+
+      # IMPLEMENTATION RESTRICTIONS #
+      INT spoolsize = 400,
+          stlim = 50,
+          arglim = 5,
+          rslim = 80,
+          pslim = 20,
+          ftlim = 10;
+
+      # ABSTRACT MACHINE #
+      MODE ITEM = UNION (INT, REF STRINGITEM, PATTERN),
+           STRINGITEM = STRUCT (STRING val, REF ITEM ref),
+           PATTERN = REF[]COMPONENT,
+           COMPONENT = STRUCT (INT routine, subsequent, alternate, extra,
+                               REF ITEM arg),
+           PSENTRY = STRUCT (INT cursor, alternate),
+           RSENTRY = REF ITEM,
+           FTENTRY = STRUCT (REF ITEM fnname, entry name,
+                             REF[]REF ITEM params, locals);
+
+      [1:spoolsize] REF ITEM spool;
+      [1:pslim] PSENTRY pattern stack;
+      [1:rslim] RSENTRY run stack;
+      [1:ftlim] FTENTRY function table;
+
+      BOOL failed := FALSE;
+      INT nin, psp, rsp := 0, ftp := 0;
+      INT mstr = 1, mlen = 2, mbrk = 3, mspn = 4, many = 5, mnul = 6,
+          miv1 = 7, miv2 = 8, m1 = 9, mat = 10, mpos = 11, mtab = 12,
+          mrpos = 13, mrtab = 14, mnty = 15;
+
+      # INTERNAL FORM OF PROGRAMS #
+
+      MODE STMT = STRUCT (REF IDR label,
+                          UNION (REF ASMT, REF MATCH,
+                                 REF REPL, REF EXPR) stmt core,
+                          REF GOTOFIELD goto),
+           IDR = STRUCT (REF ITEM idr addr),
+           NUM = STRUCT (REF ITEM num addr),
+           LSTR = STRUCT (REF ITEM lstr addr),
+           ASMT = STRUCT (REF EXPR subject, object),
+           MATCH = STRUCT (REF EXPR subject, pattern),
+           REPL = STRUCT (REF EXPR subject, pattern, object),
+           EXPR = UNION (REF UNARYEXPR, REF BINARYEXPR, IDR, NUM,
+                         LSTR, REF CALL),
+           GOTOFIELD = STRUCT (REF DEST upart, spart, fpart),
+           DEST = UNION (REF EXPR, CHAR),
+           UNARYEXPR = STRUCT (REF EXPR operand, CHAR operator),
+           BINARYEXPR = STRUCT (REF EXPR operand1, operand2,
+                                CHAR operator),
+           CALL = STRUCT (IDR fnname, REF[]REF EXPR args);
+
+      REF[]STMT t;
+      REF ITEM prog entry := NIL;
+
+      PROC error = (STRING mess) VOID:
+         (puts ("error: " + mess + "'n"); stop);
+
+      # TRANSLATION PHASE #
+
+      BEGIN # DECLARATIONS FOR SCANNER #
+            STRING card, INT cp,       # SOURCE LINE AND POINTER #
+            CHAR ch,                   # SOURCE CHARACTER #
+            [1:80]CHAR str, INT sp,    # STRING BUFFER AND POINTER #
+            CHAR tok,                  # TOKEN CODE #
+            REF ITEM psn,              # POSITION OF A CREATED VALUE #
+            INT nv,                    # NUMERIC VALUE OF CONSTANT #
+            INT stn,                   # SOURCE STATEMENT NUMBER #
+            BOOL listing,              # FLAG FOR SOURCE LISTING #
+            CHAR c;                    # TEMPORARY #
+
+            # TOKEN MNEMONICS #
+            CHAR doll    = "$",    bdoll   = "D",
+                 plus    = "+",    bplus   = "P",
+                 minus   = "-",    bminus  = "M",
+                 at      = "@",    bbar    = "!",
+                 bstar   = "*",    bslash  = "/",
+                 lpar    = "(",    rpar    = ")",
+                 comma   = ",",    colon   = ":",
+                 equal   = "=",    blank   = " ",
+                 eos     = ";",    name    = "A",
+                 lstring = "L",    number  = "U",
+                 endt    = "E",    ret     = "R",
+                 fret    = "F",    stok    = "Y",
+                 ftok    = "Z";
+
+            PROC get card = VOID:
+            BEGIN cp := 0;
+                  WHILE card := fgets (filein, 80);
+                        IF UPB card = 0 THEN exit FI;
+                        c := card[1];
+                        IF c /= "." AND c /= "+" AND c /= "-" AND c /= "*"
+                        THEN stn := stn + 1 FI;
+                        IF listing THEN puts (itoa (stn) + "    " + card + "'n") FI;
+                        IF c = "-"
+                        THEN IF card[2:5] = "LIST"
+                             THEN listing := TRUE
+                             ELIF card[2:7] = "UNLIST"
+                             THEN listing := FALSE
+                             FI
+                        FI;
+                        c = "-" OR c = "*"
+                  DO SKIP OD;
+            exit: SKIP
+            END;
+
+            PROC next ch = VOID:
+               IF cp = UPB card
+               THEN get card;
+                    IF c = "." OR c = "+"
+                    THEN ch := " "; cp := 1
+                    ELSE ch := sharp   # END OF LINE AND STATEMENT #
+                    FI
+               ELSE ch := card[cp +:= 1]
+               FI;
+
+            PROC lookup = (STRING sv) REF ITEM : (
+               INT i := 0, BOOL nf := TRUE;
+               WHILE IF (i +:= 1) <= nin
+                     THEN nf := sv /= val OF (spool[i] | (REF STRINGITEM s) : s)
+                     ELSE FALSE
+                     FI
+               DO SKIP OD;
+               IF nf
+               THEN IF nin = spoolsize THEN error ("too many strings") FI;
+                    spool[nin +:= 1] := HEAP ITEM := HEAP STRINGITEM :=
+                       (sv, NIL)
+               FI;
+               spool[i]);
+
+            PROC scan = VOID:
+               IF ch = " " # BLANKS AND BINARY OPERATORS #
+               THEN WHILE next ch; ch = " " DO SKIP OD;
+                    # IGNORE TRAILING BLANKS IN A STATEMENT #
+                    IF ch = ";" THEN next ch; stn := stn + 1; tok := eos
+                    ELIF ch = sharp THEN next ch; tok := eos
+                    ELIF ch = "!" OR ch = "$" OR ch = "+" OR ch = "-"
+                         OR ch = "*" OR ch = "/"
+                    THEN IF card[cp+1] = " "
+                         THEN c := ch;
+                              WHILE next ch; ch = " " DO SKIP OD ;
+                              tok := (c = "!" | bbar
+                                      |: c = "$" | bdoll
+                                      |: c = "-" | bminus
+                                      |: c = "+" | bplus
+                                      |: c = "*" | bstar
+                                      | bslash)
+                         ELSE tok := blank
+                         FI
+                    ELSE tok := blank
+                    FI
+               ELIF ch = "''" OR ch = """" # LITERAL STRINGS #
+               THEN c := ch; sp := 0;
+                    WHILE next ch;
+                          IF ch = sharp THEN error ("UNTERMINATED LITERAL") FI;
+                          (str[sp +:= 1] := ch) /= c
+                    DO SKIP OD ;
+                    next ch;
+                    tok := lstring;
+                    IF sp = 1
+                    THEN psn := NIL
+                    ELSE STRING s = str[1:sp-1] ;
+                         psn := lookup (s)
+                    FI
+               ELIF ch >= "0" AND ch <= "9" # NUMBERS #
+               THEN nv := 0 ;
+                    WHILE nv := nv * 10 + ABS ch - ABS "0";
+                          next ch;
+                          ch >= "0" AND ch <= "9"
+                    DO SKIP OD ;
+                    tok := number;
+                    psn := HEAP ITEM := nv
+               ELIF ch >= "A" AND ch <= "Z" # NAMES #
+               THEN sp := 0;
+                    WHILE str[sp +:= 1] := ch;
+                          next ch;
+                          ch = "." OR ch >= "A" AND ch <= "Z"
+                          OR ch >= "0" AND ch <= "9"
+                    DO SKIP OD ;
+                    STRING s = str[1:sp];
+                    tok := (s = "S" | stok
+                            |: s = "F" | ftok
+                            |: s = "END" | endt
+                            |: s = "RETURN" | ret
+                            |: s = "FRETURN" | fret
+                            | psn := lookup (s);  name)
+               ELIF ch = ";"
+               THEN next ch;  stn := stn + 1; tok := eos
+               ELIF ch = sharp
+               THEN next ch;  tok := eos
+               ELSE #  ( ) , : = @ $ + -  #
+                  tok := ch; next ch
+               FI;
+
+            PROC init = VOID:
+            BEGIN stn := 0;
+                  spool[nin := 1] := HEAP ITEM := HEAP STRINGITEM :=
+                     ("ARB", HEAP ITEM := HEAP[1:3]COMPONENT :=
+                                ((mnul, 2, 0, SKIP, NIL),
+                                 (mnul, 0, 3, SKIP, NIL),
+                                 (m1, 2, 0, SKIP, NIL)));
+                  get card;
+                  next ch;
+                  scan
+            END;
+
+            PROC verify = (CHAR token) VOID:
+               IF tok = token THEN scan
+               ELSE STRING s := "TOKEN "" "" DOES NOT OCCUR WHERE EXPECTED";
+                    s[8] := token;
+                    error (s)
+               FI;
+
+            PROC translate = VOID:
+            BEGIN HEAP[1:stlim]STMT ss, INT ssc := 0;
+                  WHILE IF ssc = stlim THEN error ("TOO MANY STATEMENTS") FI;
+                        tok /= endt
+                  DO ss[ssc +:= 1] := trans stmt OD;
+                  scan;
+                  IF tok = blank
+                  THEN scan;
+                       IF tok = name THEN prog entry := psn FI
+                  FI;
+                  t := ss[1:ssc]
+            END;
+
+            PROC trans stmt = STMT:
+            BEGIN
+               REF IDR lab := NIL;
+               REF EXPR subj, pat, obj := NIL;
+               REF GOTOFIELD go := NIL;
+               BOOL asgn;
+
+               PROC move to obj = STMT:
+               BEGIN
+                  IF tok = blank
+                  THEN scan;
+                       IF tok = colon
+                       THEN go := trans gofield
+                       ELSE obj := trans expr;
+                            IF tok = colon
+                            THEN go := trans gofield
+                            ELSE verify (eos)
+                            FI
+                       FI
+                  ELSE verify (eos)
+                  FI ;
+                  IF asgn
+                  THEN STMT (lab, HEAP ASMT := (subj, obj), go)
+                  ELSE STMT (lab, HEAP REPL := (subj, pat, obj), go)
+                  FI
+               END;
+
+               PROC move to subj = STMT:
+               BEGIN scan;
+                     IF tok = colon
+                     THEN STMT (lab, REF EXPR (NIL), trans gofield)
+                     ELSE subj := trans elem;
+                          IF tok = blank
+                          THEN scan;
+                               IF tok = colon
+                               THEN STMT (lab, REF EXPR (subj), trans gofield)
+                               ELIF tok = equal
+                               THEN asgn := TRUE; scan;  move to obj
+                               ELSE pat := trans expr;
+                                    IF tok = colon
+                                    THEN STMT (lab, HEAP MATCH := (subj, pat), trans gofield)
+                                    ELIF tok = equal
+                                    THEN asgn := FALSE; scan; move to obj
+                                    ELSE verify (eos);
+                                         STMT (lab, HEAP MATCH := (subj, pat), NIL)
+                                    FI
+                               FI
+                          ELSE verify (eos);
+                               STMT (lab, REF EXPR (subj), NIL)
+                          FI
+                     FI
+               END;
+
+               # Body of trans stmt. #
+               IF tok = name
+               THEN lab := HEAP IDR; idr addr OF lab := psn; scan;
+                    IF tok = blank
+                    THEN move to subj
+                    ELSE verify (eos);
+                         STMT (lab, REF EXPR (NIL), NIL)
+                    FI
+               ELIF tok = blank
+               THEN move to subj
+               ELSE verify (eos);
+                    STMT (lab, REF EXPR (NIL), NIL)
+               FI
+            END;
+
+            PROC trans gofield = REF GOTOFIELD:
+            BEGIN PROC where = REF DEST:
+                  BEGIN HEAP DEST d;
+                        verify (lpar);
+                        IF tok = blank THEN scan FI;
+                        d := (tok = endt | scan; "E"
+                              |: tok = ret | scan; "R"
+                              |: tok = fret | scan; "F"
+                              | trans expr);
+                        verify (rpar);
+                        d
+                  END;
+
+                  REF DEST uncond := NIL, succ := NIL, fail := NIL;
+                  scan; IF tok = blank THEN scan FI;
+                  IF tok = stok
+                  THEN scan; succ := where;
+                       IF tok = blank THEN scan FI;
+                       IF tok = ftok THEN scan; fail := where FI;
+                       verify (eos)
+                  ELIF tok = ftok
+                  THEN scan; fail := where;
+                       IF tok = blank THEN scan FI;
+                       IF tok = stok THEN scan; succ := where FI;
+                       verify (eos)
+                  ELSE uncond := where; verify (eos)
+                  FI;
+                  HEAP GOTOFIELD := (uncond, succ, fail)
+            END;
+
+            PROC trans expr = REF EXPR:
+            BEGIN REF EXPR e := trans expr1;
+                  WHILE tok = bbar
+                  DO scan;
+                     e := HEAP EXPR := HEAP BINARYEXPR := (e, trans expr1, "!")
+                  OD;
+                  e
+            END;
+
+            PROC trans expr1 = REF EXPR:
+            BEGIN REF EXPR e := trans expr2;
+                  WHILE tok = blank
+                  DO scan;
+                     IF tok /= colon AND tok /= rpar AND tok /= comma AND tok /= equal
+                     THEN e := HEAP EXPR := HEAP BINARYEXPR := (e, trans expr2, "C")
+                     FI
+                  OD;
+                  e
+            END;
+
+            PROC trans expr2 = REF EXPR:
+            BEGIN REF EXPR e := trans term;
+                  CHAR opr;
+                  WHILE tok = bplus OR tok = bminus
+                  DO opr := (tok = bplus | "+" | "-");
+                     scan;
+                     e := HEAP EXPR := HEAP BINARYEXPR := (e, trans term, opr)
+                  OD;
+                  e
+            END;
+
+            PROC trans term = REF EXPR:
+            BEGIN REF EXPR e := trans term1;
+                  WHILE tok = bslash
+                  DO scan;
+                     e := HEAP EXPR := HEAP BINARYEXPR := (e, trans term1, "/")
+                  OD;
+                  e
+            END;
+
+            PROC trans term1 = REF EXPR:
+            BEGIN REF EXPR e := trans term2;
+                  WHILE tok = bstar
+                  DO scan;
+                     e := HEAP EXPR := HEAP BINARYEXPR := (e, trans term2, "*")
+                  OD;
+                  e
+            END;
+
+            PROC trans term2 = REF EXPR:
+            BEGIN REF EXPR e := trans elem;
+                  WHILE tok = bdoll
+                  DO scan;
+                     e := HEAP EXPR := HEAP BINARYEXPR := (e, trans elem, "$")
+                  OD;
+                  e
+            END;
+
+            PROC trans elem = REF EXPR:
+               IF tok = doll OR tok = plus OR tok = minus OR tok = at
+               THEN CHAR opr = tok;
+                    scan;
+                    HEAP EXPR := HEAP UNARYEXPR := (trans element, opr)
+               ELSE trans element
+               FI;
+
+            PROC trans element = REF EXPR:
+               IF tok = name
+               THEN IDR n;
+                    idr addr OF n := psn;
+                    scan;
+                    IF tok /= lpar
+                    THEN HEAP EXPR := n
+                    ELSE HEAP[1:arglim]REF EXPR a, INT ac := 0;
+                         WHILE scan;
+                               IF tok = blank THEN scan FI;
+                               IF ac = arglim
+                               THEN error ("TOO MANY ARGUMENTS IN FUNCTION CALL")
+                               FI;
+                               IF NOT (ac = 0 AND tok = rpar)
+                               THEN a[ac +:= 1] := (tok = comma OR tok = rpar | NIL | trans expr)
+                               FI;
+                               IF tok /= comma AND tok /= rpar
+                               THEN error ("ERROR IN ARGUMENT LIST")
+                               FI;
+                               tok = comma
+                         DO SKIP OD;
+                         scan;
+                         HEAP EXPR := HEAP CALL := (n, a[1:ac])
+                    FI
+               ELIF tok = lstring
+               THEN LSTR ls;
+                    lstr addr OF ls := psn;
+                    scan;
+                    HEAP EXPR := ls
+               ELIF tok = number
+               THEN NUM nu;  num addr OF nu := psn;
+                    scan;
+                    HEAP EXPR := nu
+               ELSE verify (lpar);
+                    IF tok = blank THEN scan FI;
+                    REF EXPR e = trans expr;
+                    verify (rpar);
+                    e
+               FI;
+
+            PROC usage = VOID:
+            BEGIN puts ("Usage: snobol [-l] FILE'n");
+                  stop
+            END;
+
+            listing := FALSE;
+            IF argc < 2 THEN usage FI;
+            FOR i FROM 2 TO argc
+            DO IF argv (i) = "-l" THEN listing := TRUE
+               ELIF filein = 0
+               THEN filein := fopen (argv (i), file o rdonly);
+                    IF (filein = -1)
+                    THEN error ("opening " + argv (i) + ": " + strerror (errno)) FI
+               ELSE usage
+               FI
+            OD;
+            init;
+            translate
+      END; # TRANSLATION PHASE #
+
+      BEGIN # INTERPRETATION PHASE #
+
+            OP INTG = (REF ITEM a) INT: (a | (INT i) : i),
+               STR = (REF ITEM a) REF STRINGITEM: (a | (REF STRINGITEM s): s),
+               PAT = (REF ITEM a) PATTERN: (a | (PATTERN p) : p);
+            BOOL fn success;
+
+            PROC interpret = (INT stmt no) VOID:
+            BEGIN INT sn := stmt no; BOOL cycling := TRUE;
+
+                  PROC jump = (REF DEST dest) VOID:
+                  BEGIN failed := FALSE;
+                        CASE dest
+                        IN (REF EXPR e): sn := find label (eval softly (e)),
+                           (CHAR c): IF c = "E" THEN sn := UPB t + 1
+                                     ELIF c = "R" THEN fn success := TRUE;
+                                                       cycling := FALSE
+                                     ELSE # c = "F" # fn success := cycling := FALSE
+                                     FI
+                        ESAC
+                  END;
+
+                  WHILE cycling
+                  DO IF sn > UPB t THEN stop FI;
+                     failed := FALSE;
+
+                     # EXECUTE STATEMENT CORE #
+                     CASE stmt core OF t[sn]
+                     IN (REF ASMT a):
+                           (REF ITEM sp = eval softly (subject OF a);
+                            assign (sp, eval strongly (object OF a))),
+                        (REF MATCH m):
+                           (REF ITEM svp = eval strongly (subject OF m);
+                            match (convert to str (svp),
+                                   convert to pat (eval strongly (pattern OF m)))),
+                        (REF REPL r):
+                           (REF ITEM sp = eval softly (subject OF r);
+                            REF ITEM pp = convert to pat (eval strongly (pattern OF r));
+                            REF ITEM svp = convert to str (ref OF (STR sp));
+                            INT c = match (svp, pp);
+                            REF ITEM b = (svp IS NIL | NIL | make str ((val OF (STR svp))[c+1:]));
+                            REF ITEM obp = eval strongly (object OF r);
+                            assign (sp, concatenate (obp, b))),
+                        (REF EXPR e):
+                           eval strongly (e)
+                     ESAC;
+
+                     # PROCESS GOTO FIELD #
+                     REF GOTOFIELD go = goto OF t[sn];
+                     IF go IS NIL THEN sn := sn + 1
+                     ELIF REF DEST (upart OF go) ISNT NIL
+                     THEN jump (upart OF go)
+                     ELIF NOT failed AND (REF DEST (spart OF go) ISNT NIL)
+                     THEN jump (spart OF go)
+                     ELIF failed AND (REF DEST (fpart OF go) ISNT NIL)
+                     THEN jump (fpart OF go)
+                     ELSE sn := sn + 1
+                     FI
+                  OD
+            END; # END OF INTERPRET #
+
+            PROC find label = (REF ITEM label ptr) INT:
+            BEGIN INT stmt no := 0;
+                  IF failed THEN error ("FAILURE IN GOTO FIELD") FI;
+                  FOR i TO UPB t WHILE stmt no = 0
+                  DO IF (REF IDR (label OF t[i]) IS NIL
+                         | FALSE
+                         | label ptr IS idr addr OF label OF t[i])
+                     THEN stmt no := i
+                     FI
+                  OD;
+                  IF stmt no = 0 THEN error ("UNDEFINED LABEL") FI;
+                  stmt no
+            END;
+
+            PROC match = (REF ITEM subject ptr, pattern ptr) INT:
+               IF failed
+               THEN 0
+               ELSE PATTERN p = PAT pattern ptr;
+                    STRING subj = (subject ptr IS NIL | "" | val OF (STR subject ptr));
+                    INT u = UPB subj;
+                    INT iarg,       # INTEGER COMPONENT ARGUMENT #
+                    STRING sarg,    # STRING COMPONENT ARGUMENT #
+                    INT l;          # LENGTH OF SARG #
+                    INT cn := 1,    # COMPONENT NUMBER #
+                        c := 0,     # CURSOR #
+                        code;       # NEW CURSOR OR -1 IF COMPONENT NO-MATCH #
+                    BOOL matching := TRUE;
+
+                    psp := 0;       # CLEAR PATTERN STACK #
+                    WHILE matching
+                    DO IF alternate OF p[cn] /= 0
+                       THEN # PUSH PATTERN STACK #
+                            pattern stack[psp +:= 1] := (c, alternate OF p[cn])
+                       FI;
+                       IF REF ITEM (arg OF p[cn]) ISNT NIL
+                       THEN CASE arg OF p[cn]
+                            IN (INT i) : iarg := i,
+                               (REF STRINGITEM s):
+                                  (sarg := val OF s;  l := UPB sarg)
+                            ESAC
+                       FI;
+
+                       # EXECUTE INDICATED MATCHING ROUTINE #
+                       CASE routine OF p[cn]
+                       IN # MSTR #
+                          IF REF ITEM (arg OF p[cn]) IS NIL
+                          THEN code := c
+                          ELIF c + l > u THEN code := -1
+                          ELSE code := (sarg = subj[c+1:c+l] | c + l | -1)
+                          FI,
+                          # MLEN #
+                          code := (iarg <= u - c | c + iarg | -1),
+                          # MBRK #
+                          IF c >= u THEN code := -1
+                          ELSE INT n = break scan (subj[c+1:], sarg);
+                               code := (n < u - c | c + n | -1)
+                          FI,
+                          # MSPN #
+                          IF c >= u THEN code := -1
+                          ELIF any (sarg, subj[c+1])
+                          THEN INT j := c + 1;
+                               FOR i FROM c + 2 TO u WHILE any (sarg, subj[i])
+                               DO j := i OD;
+                               code := j
+                          ELSE code := -1
+                          FI,
+                          # MANY #
+                          IF c >= u
+                          THEN code := -1
+                          ELSE code := (any (sarg, subj[c+1]) | c + 1 | -1)
+                          FI,
+                          # MNUL #
+                          code := c,
+                          # MIV1 #
+                          code := extra OF p[cn] := c,
+                          # MIV2 #
+                          (INT m = extra OF p[cn - extra OF p[cn]] + 1;
+                           assign (arg OF p[cn], make str (subj[m:c]));
+                           code := c),
+                          # M1 #
+                          code := (1 <= u - c | c + 1 | -1),
+                          # MAT #
+                          (assign (arg OF p[cn], make int (c));
+                           code := c),
+                          # MPOS #
+                          code := (c = iarg | c | -1),
+                          # MTAB #
+                          code := (c <= iarg AND iarg <= u | iarg | -1),
+                          # MRPOS #
+                          code := (u - c = iarg | c | -1),
+                          # MRTAB #
+                          code := (u - c >= iarg | u - iarg | -1),
+                          # MNTY #
+                          IF c >= u
+                          THEN code := -1
+                          ELSE code := (any (sarg, subj[c+1]) | -1 | c + 1)
+                          FI
+                       ESAC;
+
+                       # DECIDE WHAT TO DO NEXT #
+                       IF code >= 0
+                       THEN IF subsequent OF p[cn] = 0
+                            THEN matching := FALSE #SUCCESSFUL TERMINATION #
+                            ELSE cn := subsequent OF p[cn];
+                                 c := code  # CONTINUE #
+                            FI
+                       ELIF psp = 0
+                       THEN failed := TRUE;
+                            matching := FALSE  # STMT FAILURE #
+                       ELSE  # POP PATTERN STACK TO BACKTRACK #
+                             cn := alternate OF pattern stack[psp];
+                             c := cursor OF pattern stack[psp];
+                             psp := psp - 1
+                       FI
+                    OD;
+                    (failed | 0 | code)
+               FI; # END OF MATCH PROCEDURE #
+
+            PROC assign = (REF ITEM subject ptr, object ptr) VOID:
+               IF failed THEN SKIP
+               ELSE REF STRINGITEM s = STR subject ptr;
+                    ref OF s := object ptr;
+                    IF val OF s = "OUTPUT"
+                    THEN IF object ptr IS NIL
+                         THEN puts ("'n")
+                         ELSE CASE object ptr
+                              IN (REF STRINGITEM r): puts ((val OF r) + "'n"),
+                                 (INT i): puts (itoa (i) + "'n"),
+                                 (PATTERN): (error ("ATTEMPT TO OUTPUT PATTERN"); SKIP)
+                              ESAC
+                         FI
+                    FI
+               FI;
+
+            PROC eval softly = (REF EXPR expression) REF ITEM:
+               IF failed THEN SKIP
+               ELSE CASE expression # CAN NEVER BE NIL #
+                    IN (IDR id): idr addr OF id,
+                       (REF UNARYEXPR ue):
+                          IF operator OF ue = "$"
+                          THEN REF ITEM r = convert to str (eval strongly (operand OF ue));
+                               IF r IS NIL
+                               THEN error ("NULL RESULT WHERE VAR REQUIRED");
+                                    SKIP
+                               ELSE r
+                               FI
+                          ELSE error ("INAPPROPRIATE UNARY EXPR WHERE VAR REQUIRED");
+                               SKIP
+                          FI
+                    OUT error ("INAPPROPRIATE EXPR WHERE VAR REQUIRED");
+                        SKIP
+                    ESAC
+               FI;
+
+            PROC eval strongly = (REF EXPR expression) REF ITEM:
+               IF failed THEN SKIP
+               ELIF expression IS NIL THEN NIL
+               ELSE CASE expression
+                    IN (IDR id):
+                          (REF STRINGITEM s = STR (idr addr OF id);
+                           IF val OF s = "INPUT"
+                           THEN STRING line;
+                                # SNOBOL programs read data from stdin.  #
+                                line := gets (80);
+                                IF (line = "") THEN failed := TRUE; eof FI;
+                                assign (idr addr OF id, make str (line));
+                                eof: SKIP
+                           FI;
+                           ref OF s),
+                       (NUM nbr):
+                          num addr OF nbr,
+                       (LSTR ls):
+                          lstr addr OF ls,
+                       (REF UNARYEXPR ue):
+                          (REF ITEM arg ptr = (operator OF ue = "@"
+                                               | eval softly (operand OF ue)
+                                               | eval strongly (operand OF ue));
+                           eval unary (arg ptr, operator OF ue)),
+                       (REF BINARYEXPR be):
+                          (REF ITEM arg1 ptr = eval strongly (operand1 OF be);
+                           REF ITEM arg2 ptr = (operator OF be = "$"
+                                                | eval softly (operand2 OF be)
+                                                | eval strongly (operand2 OF be));
+                           eval binary (arg1 ptr, arg2 ptr, operator OF be)),
+                       (REF CALL cl):
+                          (INT n = UPB args OF cl;
+                           [1:n]REF ITEM arglist;
+                           FOR i TO n
+                           DO arglist[i] := eval strongly ((args OF cl)[i]) OD;
+                           eval call (idr addr OF fnname OF cl, arglist))
+                    ESAC
+               FI;
+
+            PROC eval unary = (REF ITEM arg ptr, CHAR opr) REF ITEM:
+               IF failed THEN SKIP
+               ELSE IF opr = "$"
+                    THEN IF arg ptr IS NIL
+                         THEN error ("INDIRECTION APPLIED TO NULL STRING");
+                              SKIP
+                         ELSE ref OF (STR convert to str (arg ptr))
+                         FI
+                    ELIF opr = "+"
+                    THEN convert to int (arg ptr)
+                    ELIF opr = "-"
+                    THEN INT k = INTG convert to int (arg ptr);
+                         make int (-k)
+                    ELSE # OPR = "@" #
+                         make pat comp (mat, arg ptr)
+                    FI
+               FI;
+
+            PROC eval binary = (REF ITEM arg1 ptr, arg2 ptr, CHAR opr) REF ITEM:
+               IF failed THEN SKIP
+               ELSE IF opr = "$"
+                    THEN REF ITEM c = concatenate (make pat comp (miv1, NIL),
+                                                   arg1 ptr);
+                         concatenate (c, make pat comp (miv2, arg2 ptr))
+                    ELIF opr = "*" OR opr = "/" OR opr = "+" OR opr = "-"
+                    THEN INT m = INTG convert to int (arg1 ptr),
+                         n = INTG convert to int (arg2 ptr);
+                         make int ((opr = "*" | m * n
+                                    |: opr = "/" | m OVER n
+                                    |: opr = "+" | m + n | m - n))
+                    ELIF opr = "C"
+                    THEN concatenate (arg1 ptr, arg2 ptr)
+                    ELSE # OPR = "!" #
+                         PATTERN p1 = PAT convert to pat (arg1 ptr),
+                         p2 = PAT convert to pat (arg2 ptr);
+                         INT u1 = UPB p1, u2 = UPB p2;
+                         PATTERN p = HEAP[u1 + u2]COMPONENT,
+                         INT offset = u1 + 1, INT j := 1;
+                         p[1:u1] := p1[1:u1];
+                         WHILE alternate OF p[j] /= 0
+                         DO j := alternate OF p[j] OD;
+                         alternate OF p[j] := offset;
+                         FOR i FROM offset TO u1 + u2
+                         DO p[i] := p2 [i - u1];
+                            IF subsequent OF p[i] /= 0
+                            THEN subsequent OF p[i] +:= u1
+                            FI;
+                            IF alternate OF p[i] /= 0
+                            THEN alternate OF p[i] +:= u1
+                            FI
+                         OD;
+                         HEAP ITEM := p
+                    FI
+               FI;
+
+            PROC eval call = (REF ITEM name ptr, REF[]REF ITEM arglist) REF ITEM:
+               IF failed THEN SKIP
+               ELSE # SEARCH FUNCTION TABLE FOR NAME #
+                    BOOL not found := TRUE, INT j;
+                    FOR i TO ftp WHILE not found
+                    DO IF name ptr IS fnname OF function table[i]
+                       THEN j := i; not found := FALSE
+                       FI
+                    OD;
+                    IF not found
+                    THEN exec prim fn (name ptr, arglist)
+                    ELSE #PROGRAMMER-DEFINED FUNCTION #
+
+                         PROC stack = (REF ITEM a) VOID:
+                            (IF rsp = rslim THEN error ("RUN STACK OVERFLOW") FI;
+                             run stack [rsp +:= 1] := a);
+
+                         PROC unstack = REF ITEM:
+                            (IF rsp = 0 THEN error ("RETURN FROM LEVEL 0") FI;
+                             run stack [(rsp -:= 1) + 1]);
+
+                         REF STRINGITEM name = STR name ptr;
+
+                         # ENTRY PROTOCOL #
+                         stack (ref OF name);
+                         assign (name ptr, NIL);
+                         REF[]REF ITEM params = params OF function table[j],
+                         INT n = UPB arglist;
+                         IF UPB params /= n
+                         THEN error ("WRONG NUMBER OF ARGUMENTS IN CALL")
+                         FI;
+                         FOR i TO n
+                         DO stack (ref OF (STR params[i]));
+                            assign (params[i], arglist[i])
+                         OD;
+                         REF[]REF ITEM locals = locals OF function table[j];
+                         FOR i TO UPB locals
+                         DO stack (ref OF (STR locals[i]));
+                            assign (locals[i], NIL)
+                         OD;
+
+                         interpret (find label (entry name OF function table[j]));
+
+                         # RETURN PROTOCOL #
+                         FOR i FROM UPB locals BY -1 TO 1
+                         DO assign (locals[i], unstack) OD;
+                         FOR i FROM n BY -1 TO 1
+                         DO assign (params[i], unstack) OD;
+                         REF ITEM result = ref OF name;
+                         assign (name ptr, unstack);
+                         (fn success | result | failed := TRUE ; SKIP)
+                    FI
+               FI;
+
+            PROC exec prim fn = (REF ITEM name ptr,
+                                 REF[]REF ITEM arglist) REF ITEM:
+            BEGIN
+                  PROC gen1 = (INT routine) REF ITEM:
+                  BEGIN # CREATE PATTERN COMPONENT WITH STRING ARGUMENT #
+                        REF ITEM arg = convert to str (arglist[1]);
+                        IF arg IS NIL
+                        THEN error ("NULL ARG FOR PATTERN-VALUED PRIMITIVE FUNCTION" )
+                        FI;
+                        make pat comp (routine, arg)
+                  END;
+
+                  PROC gen2 = (INT routine) REF ITEM:
+                  BEGIN # CREATE PATTERN COMPONENT WITH INTEGER ARGUMENT #
+                        REF ITEM arg = convert to int (arglist[1]);
+                        IF INTG arg < 0
+                        THEN error ("NEGATIVE ARG FOR PATTERN-VALUED PRIMITIVE FUNCTION")
+                        FI;
+                        make pat comp (routine, arg)
+                  END;
+
+                  STRING fn = val OF (STR name ptr), INT n = UPB arglist;
+                  IF fn = "LE" AND n = 2
+                  THEN IF INTG convert to int (arglist[1])
+                          <= INTG convert to int (arglist[2])
+                       THEN NIL
+                       ELSE failed := TRUE;
+                            SKIP
+                       FI
+                  ELIF fn = "EQ" AND n = 2
+                  THEN IF INTG convert to int (arglist[1])
+                          = INTG convert to int (arglist[2])
+                       THEN NIL
+                       ELSE failed := TRUE;
+                            SKIP
+                       FI
+                  ELIF fn = "NE" AND n = 2
+                  THEN IF INTG convert to int (arglist[1])
+                          /= INTG convert to int (arglist[2])
+                       THEN NIL
+                       ELSE failed := TRUE;
+                            SKIP
+                       FI
+                  ELIF fn = "IDENT" AND n = 2
+                  THEN IF REF ITEM (arglist[1]) IS arglist[2]
+                       THEN NIL
+                       ELSE failed := TRUE;
+                            SKIP
+                       FI
+                  ELIF fn = "DIFFER" AND n = 2
+                  THEN IF REF ITEM (arglist[1]) ISNT arglist[2]
+                       THEN NIL
+                       ELSE failed := TRUE;
+                            SKIP
+                       FI
+                  ELIF fn = "ANY" AND n = 1 THEN gen1 (many)
+                  ELIF fn = "LEN" AND n = 1 THEN gen2 (mlen)
+                  ELIF fn = "POS" AND n = 1 THEN gen2 (mpos)
+                  ELIF fn = "TAB" AND n = 1 THEN gen2 (mtab)
+                  ELIF fn = "SPAN" AND n = 1 THEN gen1 (mspn)
+                  ELIF fn = "RPOS" AND n = 1 THEN gen2 (mrpos)
+                  ELIF fn = "RTAB" AND n = 1 THEN gen2 (mrtab)
+                  ELIF fn = "BREAK" AND n = 1 THEN gen1 (mbrk)
+                  ELIF fn = "NOTANY" AND n = 1 THEN gen1 (mnty)
+                  ELIF fn = "SIZE" AND n = 1
+                  THEN make int (UPB val OF (STR convert to str (arglist[1])))
+                  ELIF fn = "DEFINE" AND n = 2
+                  THEN IF REF ITEM (arglist[1]) IS NIL
+                       THEN error ("NULL PROTOTYPE") FI;
+                       STRING prototype = val OF (STR convert to str (arglist[1]));
+                       REF ITEM entry = convert to str (arglist[2]);
+                       IF entry IS NIL THEN error ("NULL ENTRY LABEL") FI;
+
+                       PROC check and find = (STRING str) REF ITEM:
+                       BEGIN IF UPB str = 0 THEN error ("ILLEGAL PROTOTYPE") FI;
+                             STRING an = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.";
+                             IF NOT any (an[:26], str[1])
+                             THEN error ("ILLEGAL PROTOTYPE") FI;
+                             FOR i FROM 2 TO UPB str
+                             DO IF NOT any (an, str[i])
+                                THEN error ("ILLEGAL PROTOTYPE")
+                                FI
+                             OD;
+                             make str (str)
+                       END;
+
+                       PROC breakup = (STRING str) REF[]REF ITEM:
+                       BEGIN #ANALYZE A LIST OF IDENTIFIERS #
+                             [1:arglim]REF ITEM r, INT p := 0, a := 1, b;
+                             WHILE a <= UPB str
+                             DO b := break scan (str[a:], ",");
+                                IF p >= arglim
+                                THEN error ("TOO MANY PARAMETERS OR LOCALS IN PROTOTYPE") FI;
+                                r[p +:= 1] := check and find (str[a:a+b-1]);
+                                a := a + b + 1
+                             OD;
+                             HEAP[1:p]REF ITEM := r[:p]
+                       END;
+
+                       INT lp = UPB prototype;
+                       INT a = break scan (prototype, "(");
+                       IF a >= lp THEN error ("ILLEGAL PROTOTYPE") FI;
+                       REF ITEM name ptr = check and find (prototype[:a]);
+                       INT b = break scan (prototype[a+2:], ")");
+                       IF b >= lp - a - 1 THEN error ("ILLEGAL PROTOTYPE") FI;
+                       REF[]REF ITEM params = breakup (prototype[a+2:a+1+b]);
+                       REF[]REF ITEM locals = breakup (prototype[a+b+3:]);
+
+                       BOOL not found := TRUE;
+                       FOR i TO ftp WHILE not found
+                       DO IF name ptr IS fnname OF function table[i]
+                          THEN not found := FALSE;
+                               function table[i] := (name ptr, entry, params, locals)
+                          FI
+                       OD;
+                       IF not found
+                       THEN IF ftp = ftlim
+                            THEN error ("FUNCTION TABLE OVERFLOW") FI;
+                            function table [ftp +:= 1] := (name ptr, entry, params, locals)
+                       FI;
+                       NIL # RESULT OF DEFINE(...) #
+                  ELSE error ("ILLEGAL FUNCTION CALL");
+                       SKIP
+                  FI
+            END;
+
+            PROC concatenate = (REF ITEM ptr1, ptr2) REF ITEM:
+            BEGIN
+
+                  PROC concat patterns = (PATTERN p1, p2) REF ITEM:
+                  BEGIN INT u1 = UPB p1, u2 = UPB p2;
+                        PATTERN p = HEAP[u1 + u2]COMPONENT;
+                        INT offset = u1 + 1;
+                        FOR i TO u1
+                        DO p[i] := p1[i];
+                           IF subsequent OF p[i] = 0
+                           THEN subsequent OF p[i] := offset FI
+                        OD;
+                        FOR i FROM offset TO u1 + u2
+                        DO p[i] := p2[i - u1];
+                           IF subsequent OF p[i] /= 0
+                           THEN subsequent OF p[i] +:= u1 FI;
+                           IF alternate OF p[i] /= 0
+                           THEN alternate OF p[i] +:= u1 FI
+                        OD;
+                        IF u2 = 1 AND routine OF p[offset] = miv2
+                        THEN extra OF p[offset] := u1 FI;
+                        HEAP ITEM := p
+                  END;
+
+                  IF failed THEN SKIP
+                  ELSE IF ptr1 IS NIL THEN ptr2
+                       ELIF ptr2 IS NIL THEN ptr1
+                       ELSE CASE ptr1
+                            IN (PATTERN p1):
+                                concat patterns (p1, PAT convert to pat (ptr2))
+                            OUSE ptr2
+                            IN (PATTERN p2):
+                                concat patterns (PAT convert to pat (ptr1), p2)
+                            OUT STRING s1 = val OF (STR convert to str (ptr1));
+                                make str (s1 + val OF (STR convert to str (ptr2)))
+                            ESAC
+                       FI
+                  FI
+            END;
+
+            PROC convert to int = (REF ITEM ptr) REF ITEM:
+               IF failed THEN SKIP
+               ELSE IF ptr IS NIL THEN make int (0)
+                    ELSE CASE ptr
+                         IN (INT): ptr,
+                            (PATTERN): (error ("PATTERN VALUE WHERE INTEGER REQUIRED"); SKIP),
+                            (REF STRINGITEM s):
+                               (INT n := 0, d, z := ABS "0";
+                                FOR i TO UPB val OF s
+                                DO d := ABS (val OF s)[i] - z;
+                                   IF d < 0 OR d > 9
+                                   THEN error ("STRING NOT CONVERTIBLE TO INTEGER") FI;
+                                   n := n * 10 + d
+                                OD;
+                                make int (n))
+                         ESAC
+                    FI
+               FI;
+
+            PROC convert to pat = (REF ITEM ptr) REF ITEM:
+               IF failed THEN SKIP
+               ELSE IF ptr IS NIL
+                    THEN make pat comp (mstr, NIL)
+                    ELSE CASE ptr
+                         IN (PATTERN): ptr
+                         OUT make pat comp (mstr, convert to str (ptr))
+                         ESAC
+                    FI
+               FI;
+
+            PROC convert to str = (REF ITEM ptr) REF ITEM:
+               IF failed THEN SKIP
+               ELSE IF ptr IS NIL THEN ptr
+                    ELSE CASE ptr
+                         IN (REF STRINGITEM): ptr,
+                            (PATTERN): (error ("PATTERN VALUE WHERE STRING REQUIRED"); SKIP),
+                            (INT i): make str (itoa (i))
+                         ESAC
+                    FI
+               FI;
+
+            PROC make int = (INT val) REF ITEM:
+               IF failed THEN SKIP
+               ELSE HEAP ITEM := val
+               FI;
+
+            PROC make pat comp = (INT routine, REF ITEM arg) REF ITEM:
+               IF failed THEN SKIP
+               ELSE HEAP ITEM := HEAP[1:1]COMPONENT := COMPONENT (routine, 0, 0, SKIP, arg)
+               FI;
+
+            PROC make str = (STRING val) REF ITEM:
+               IF failed THEN SKIP
+               ELIF UPB val = 0 THEN NIL
+               ELSE INT i := 0, BOOL nf := TRUE;
+                    WHILE IF (i +:= 1) <= nin
+                          THEN nf := val /= val OF (STR spool [i])
+                          ELSE FALSE
+                          FI
+                    DO SKIP OD;
+                    IF nf
+                    THEN IF nin = spoolsize THEN error ("TOO MANY STRINGS") FI;
+                         spool[nin +:= 1] := HEAP ITEM := HEAP STRINGITEM := (val, NIL)
+                    FI;
+                    spool[i]
+               FI;
+
+            PROC break scan = (STRING str, arg) INT:
+            BEGIN # RESULT = UPB STR IF NO BREAK CHAR, LESS OTHERWISE #
+                  INT j := 0;
+                  FOR i TO UPB str WHILE NOT any (arg, str[i])
+                  DO j := i OD;
+                  j
+            END;
+
+            PROC any = (STRING str, CHAR ch) BOOL:
+            BEGIN BOOL nf;
+                  FOR i TO UPB str WHILE nf := ch /= str[i] DO SKIP OD;
+                  NOT nf
+            END;
+
+            interpret ((REF ITEM (prog entry) IS NIL | 1 | find label (prog entry)))
+      END # INTERPRETATION PHASE #
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/supper-1.a68
@@ -0,0 +1,11 @@
+{ dg-options {-fstropping=supper} }
+
+begin mode Some_Mode = real;
+      Some_Mode some_real := random;
+
+      puts ("Hello time for SUPPER!\n");
+      if some_real > 0.5
+      then puts ("YES\n")
+      else puts ("NO\n")
+      fi
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/supper-10.a68
@@ -0,0 +1,6 @@
+{ dg-options {-fstropping=supper} }
+
+begin mode BEGIN = int;
+      BEGIN some_int = 10;
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/supper-11.a68
@@ -0,0 +1,6 @@
+{ dg-options {-fstropping=supper} }
+
+begin mode BEGIN = int;
+      BEGIN some_int = 10;
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/supper-12.a68
@@ -0,0 +1,6 @@
+{ dg-options {-fstropping=supper} }
+
+begin for i while i < 10
+      do puts ("lala\n")
+      od
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/supper-13.a68
@@ -0,0 +1,7 @@
+{ dg-options "-fstropping=supper" }
+
+{ mode_ should not be recognized as a symbol.  }
+
+begin int mode_ = 10;
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/supper-2.a68
@@ -0,0 +1,5 @@
+{ dg-options {-fstropping=supper} }
+
+begin int foo_bar = 10;
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/supper-3.a68
@@ -0,0 +1,5 @@
+{ dg-options {-fstropping=supper} }
+
+begin int foo_bar_ = 10;
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/supper-4.a68
@@ -0,0 +1,5 @@
+{ dg-options {-fstropping=supper} }
+
+begin int foo_ = 10;
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/supper-5.a68
@@ -0,0 +1,6 @@
+{ dg-options {-fstropping=supper} }
+
+begin mode Foo_bar = int;
+      Foo_bar some_int = 10;
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/supper-6.a68
@@ -0,0 +1,5 @@
+{ dg-options {-fstropping=supper} }
+
+begin go to done;
+done: skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/supper-7.a68
@@ -0,0 +1,5 @@
+{ dg-options {-fstropping=supper} }
+
+begin goto done;
+done: skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/supper-8.a68
@@ -0,0 +1,6 @@
+{ dg-options {-fstropping=supper} }
+
+begin mode Int = int;
+      Int some_int = 10;
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/supper-9.a68
@@ -0,0 +1,6 @@
+{ dg-options {-fstropping=supper} }
+
+begin mode BEGIN = int;
+      BEGIN some_int = 10;
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/uniting-1.a68
@@ -0,0 +1,8 @@
+{ dg-options {-fstropping=supper} }
+begin mode JSON_Val = union (int,ref JSON_Obj),
+           JSON_Obj = struct (int je),
+
+      proc json_new_obj = JSON_Val:
+         (JSON_Obj o; o);
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/upper-1.a68
@@ -0,0 +1,11 @@
+# { dg-options {-fstropping=upper} }  #
+
+BEGIN MODE SOME_MODE = REAL;
+      SOME_MODE some_real := random;
+
+      puts ("Hello time for SUPPER!\n");
+      IF some_real > 0.5
+      THEN puts ("YES\n")
+      ELSE puts ("NO\n")
+      FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/warning-scope-1.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+
+# Potential scope violation warnings are disabled by default.  #
+BEGIN PROC increase = (REF INT i) REF INT:
+      BEGIN INT j := i;
+            j # Inhibited warning.  #
+      END;
+      increase (LOC INT)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/warning-scope-2.a68
@@ -0,0 +1,8 @@
+# { dg-options {-Wscope -fstropping=upper} }  #
+BEGIN PROC increase = (REF INT i) REF INT:
+      BEGIN
+         INT j := i;
+         j # { dg-warning "scope violation" } #
+      END;
+      increase (LOC INT)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/warning-scope-3.a68
@@ -0,0 +1,3 @@
+# { dg-options {-Wscope -fstropping=upper} }  #
+(REF INT xx;
+ xx := (INT x; x := 3)) # { dg-warning "scope violation" }  #
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/warning-scope-4.a68
@@ -0,0 +1,3 @@
+# { dg-options {-Wscope -fstropping=upper} }  #
+(REF INT xx;
+ (INT x; xx:= x; x := 3)) # { dg-warning "scope violation" }  #
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/warning-scope-5.a68
@@ -0,0 +1,8 @@
+# { dg-options {-Wscope -fstropping=upper} }  #
+# The scope violation here is due to the routine text, which is copied
+  to P, referring to a value whose range doesn't exist anymore: X #
+BEGIN (PROC REAL p;
+       (REAL x;
+        p := REAL: x * 2); # { dg-warning "scope violation" }  #
+       p)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/warning-scope-6.a68
@@ -0,0 +1,6 @@
+# { dg-options {-Wscope -fstropping=upper} }  #
+BEGIN (PROC REAL p; REAL mypi := 3.14;
+       (REAL x;
+        p := REAL: mypi * 2); # No scope violation here.  #
+       p)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/warning-scope-7.a68
@@ -0,0 +1,12 @@
+# { dg-options {-Wscope -fstropping=upper} }  #
+# N,M below represent pairs of insc, outsc  #
+BEGIN (INT x;
+       REF INT xx;
+       (REF INT yy;
+        INT y;
+        xx := yy; # 0,0 := 1,0. Dynamic check.  #
+        yy := y;  # 1,1 := 1,1. OK  #
+        xx := y   # 0,0 := 1,1. { dg-warning "scope violation" } #
+       )
+      )
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/warning-voiding-1.a68
@@ -0,0 +1,5 @@
+# { dg-options {-Wvoiding -fstropping=upper} }  #
+BEGIN PROC sum = (INT a, INT b) INT:
+         ( a + b );
+      sum (10, 20) # { dg-warning "will be voided" } #
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/compile/warning-voiding-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+
+BEGIN PROC sum = (INT a, INT b) INT:
+         ( a + b );
+      sum (10, 20) # Voiding warning won't be emitted by default.  #
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/abs-bits-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# ABS for SIZETY BITS #
+BEGIN ASSERT (255 = ABS 16rff);
+      ASSERT (LONG 255 = ABS LONG 16rff);
+      ASSERT (LONG LONG 255 = ABS LONG LONG 16rff)
+      # XXX test ABS of negative numbers (extension).  #
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/abs-bool-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (ABS TRUE /= 0);
+      ASSERT (ABS FALSE = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/abs-char-1.a68
@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (ABS "a" = 97)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/abs-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (ABS 10 = 10);
+      ASSERT (ABS -10 = 10);
+      ASSERT (ABS SHORT 10 = SHORT 10);
+      ASSERT (ABS - SHORT 10 = SHORT 10);
+      ASSERT (ABS - SHORT SHORT 10 = SHORT SHORT 10);
+      ASSERT (ABS LONG 10 = LONG 10);
+      ASSERT (ABS - LONG 10 = LONG 10);
+      ASSERT (ABS - LONG LONG 10 = LONG LONG 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/abs-int-negative-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper -std=algol68" }  #
+BEGIN SHORT SHORT BITS b = BIN - SHORT SHORT 2;
+      ASSERT (ABS b = SHORT SHORT INT (SKIP))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/abs-int-negative-gnu-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper -std=gnu68" }  #
+BEGIN SHORT SHORT BITS b = BIN - SHORT SHORT 2;
+      ASSERT (ABS b = - SHORT SHORT 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/acos-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL r = 1.0;
+      LONG REAL rr = LONG 45.0;
+      LONG LONG REAL rrr = LONG LONG 60.0;
+      ASSERT (arccos (r) = 0.0);
+      long arccos (rr);
+      long long arccos (rrr)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/affirm-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 10;
+      LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+      SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10;
+      ASSERT (+i = 10);
+      ASSERT (+ii  = LONG 10);
+      ASSERT (+iii = LONG LONG 10);
+      ASSERT (+ss  = SHORT 10);
+      ASSERT (+sss = SHORT SHORT 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/and-bits-1.a68
@@ -0,0 +1,18 @@
+# { dg-options "-fstropping=upper" }  #
+# AND for SIZETY BITS.  #
+BEGIN BITS b = 16r0f0f0;
+      ASSERT ((b AND 16r0f0f) = 16r0);
+      ASSERT ((b AND 16r00ff) = 16rf0);
+      LONG BITS bb = LONG 16r0f0f0;
+      ASSERT ((bb AND LONG 16r0f0f) = LONG 16r0);
+      ASSERT ((bb AND LONG 16r00ff) = LONG 16rf0);
+      LONG LONG BITS bbb = LONG LONG 16r0f0f0;
+      ASSERT ((bbb AND LONG LONG 16r0f0f) = LONG LONG 16r0);
+      ASSERT ((bbb AND LONG LONG 16r00ff) = LONG LONG 16rf0);
+      SHORT BITS ss = SHORT 16r0f0f0;
+      ASSERT ((ss AND SHORT 16r0f0f) = SHORT 16r0);
+      ASSERT ((ss AND SHORT 16r00ff) = SHORT 16rf0);
+      SHORT SHORT BITS sss = SHORT SHORT 16r0f0f0;
+      ASSERT ((sss AND SHORT SHORT 16r0f0f) = SHORT SHORT 16r0);
+      ASSERT ((sss AND SHORT SHORT 16r00ff) = SHORT SHORT 16rf0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/andf-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 10;
+      ASSERT (i /= 0 ANDTH i = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/ascription-1.a68
@@ -0,0 +1,12 @@
+# { dg-options "-fstropping=upper" }  #
+# Make sure structs are copied when ascribed.  #
+BEGIN MODE BAR = STRUCT (INT j, REAL r);
+      MODE FOO = STRUCT (INT i, BAR bar);
+
+      FOO f1 := (10, (20, 3.14));
+      FOO f2 = f1;
+
+      j OF bar OF f1 := 200;
+      ASSERT (j OF bar OF f1 = 200);
+      ASSERT (j OF bar OF f2 = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/asin-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL r = 0.0;
+      LONG REAL rr = LONG 45.0;
+      LONG LONG REAL rrr = LONG LONG 60.0;
+      ASSERT (arcsin (r) = 0.0);
+      long arcsin (rr);
+      long long arcsin (rrr)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/assert-1.a68
@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (TRUE)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/assignation-char-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN CHAR c;
+      c := "x";
+      ASSERT (c = "x")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/assignation-int-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i;
+      i := 20;
+      ASSERT (i = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/assignation-int-2.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN x := 100;
+      INT x;
+      ASSERT (x = 100)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/assignation-int-3.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REF INT j = LOC INT;
+      INT i;
+      i := j := 20;
+      ASSERT (i + j = 40)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/assignation-int-4.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REF INT xx;
+      INT x := 10;
+      ASSERT ((xx := (x)) = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/assignation-int-5.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      REF INT xx := x;
+      x := 20;
+      ASSERT ((xx := (INT j; x)) = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/assignation-multiple-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRUCT ([2:3]INT m, [1:5]REAL g) s;
+      g OF s:= (1.0, 2.0, 3.0, 4.0, 5.0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/assignation-multiple-2.a68
@@ -0,0 +1,15 @@
+begin [5]struct(char i, real r) foo;
+
+      { The stride in the single dimension of the multiple resulting
+        from the selection is not the size of a 'char'.  }
+      i of foo := ("a","b","c","d","e");
+      puts ((i of foo) + "'n");
+      { Via indexing then selection.  }
+      assert (i of foo[1] = "a");
+      assert (i of foo[2] = "b");
+      assert (i of foo[3] = "c");
+      assert (i of foo[4] = "d");
+      assert (i of foo[5] = "e");
+      { Via selection of multiple.  }
+      assert (i of foo = "abcde");
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/assignation-struct-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE NODE = STRUCT (INT one, two, three);
+      NODE top;
+      top := (10,20,30);
+      ASSERT (two OF top = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/assignation-struct-2.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# Struct containing a multiple, which must be copied when
+  the struct value is assigned.  #
+BEGIN MODE FOO = STRUCT (STRING s, INT i);
+      FOO f1;
+      f1 := ("foo", 10);
+      ASSERT (i OF f1 = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/atan-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL r = 0.0;
+      LONG REAL rr = LONG 45.0;
+      LONG LONG REAL rrr = LONG LONG 60.0;
+      ASSERT (arctan (r) = 0.0);
+      long arctan (rr);
+      long long arctan (rrr)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/balancing-1.a68
@@ -0,0 +1,12 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL x, y;
+      REF REAL xx, yy;
+      xx := yy := x;
+
+      ASSERT (xx :=: x);
+      ASSERT (x :=: xx);
+      ASSERT (xx :/=: yy);
+      ASSERT (REF REAL (xx) :=: yy);
+      ASSERT (xx :=: REF REAL (yy));
+      ASSERT (REF REAL (xx) :=: REF REAL (yy))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/balancing-rows-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (UPB IF FALSE THEN []INT (1) ELSE [,]REAL (1) FI = 1);
+      ASSERT (2 UPB CASE 2 IN []INT (1), [,]REAL (1) ESAC = 1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/bin-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# BIN for SIZETY INTs #
+BEGIN ASSERT (BIN 255 = 16rff);
+      ASSERT (BIN LONG 255 = LONG 16rff);
+      ASSERT (BIN LONG LONG 255 = LONG LONG 16rff)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/bin-negative-1.a68
@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper -std=algol68" }  #
+BEGIN ASSERT (BIN - SHORT SHORT 2 = SHORT SHORT 2r0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/bin-negative-gnu-1.a68
@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper -std=gnu68" }  #
+BEGIN ASSERT (BIN - SHORT SHORT 2 = SHORT SHORT 2r11111110)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/boolops-1.a68
@@ -0,0 +1,18 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN BOOL t := TRUE;
+      BOOL f := FALSE;
+      ASSERT (NOT t = FALSE);
+      ASSERT (~t = FALSE);
+      ASSERT ((t AND t) = TRUE);
+      ASSERT ((t AND f) = FALSE);
+      ASSERT ((f AND f) = FALSE);
+      ASSERT ((f AND t) = FALSE);
+      ASSERT ((t OR t) = TRUE);
+      ASSERT ((t OR f) = TRUE);
+      ASSERT ((f OR f) = FALSE);
+      ASSERT ((f OR t) = TRUE);
+      ASSERT ((t XOR t) = FALSE);
+      ASSERT ((t XOR f) = TRUE);
+      ASSERT ((f XOR f) = FALSE);
+      ASSERT ((f XOR t) = TRUE)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/call-1.a68
@@ -0,0 +1,19 @@
+# { dg-options "-fstropping=upper" }  #
+# Calling a procedure that gets a row of united values.  #
+BEGIN INT num ints := 0, num reals := 0, num strings := 0;
+      PROC foo = ([]UNION(INT,REAL,STRING) d) VOID:
+      BEGIN FOR i TO UPB d
+            DO CASE d[i]
+               IN (STRING): num strings +:= 1,
+                  (INT): num ints +:= 1,
+                  (REAL): num reals +:= 1
+               ESAC
+            OD
+      END;
+      foo (());
+      foo (10);
+      ASSERT (num ints = 1 AND num reals = 0 AND num strings = 0);
+      num ints := 0;
+      foo (("baz", 1, 3.14, 2, 0.0, "foo"));
+      ASSERT (num ints = 2 AND num reals = 2 AND num strings = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/call-2.a68
@@ -0,0 +1,21 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT control := 0;
+      PROC set control = (PROC(INT)VOID p) VOID: p (100);
+      PROC setter = (INT i) VOID: control := i;
+      PROC(INT)VOID setter 2 = (INT i) VOID: control := i + 1;
+      PROC(INT)VOID setter 3 := setter 2;
+      PROC(INT)VOID setter 4 := (INT i) VOID: control := i + 2;
+      REF PROC(INT)VOID setter 5 := setter 4;
+      set control (setter);
+      ASSERT (control = 100);
+      set control (setter 2);
+      ASSERT (control = 101);
+      control := 0;
+      set control (setter 3);
+      ASSERT (control = 101);
+      set control (setter 4);
+      ASSERT (control = 102);
+      control := 0;
+      set control (setter 5);
+      ASSERT (control = 102)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/case-clause-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT j := 1;
+      ASSERT ((j|10,20,30|40) = 10);
+      j := 2;
+      ASSERT ((j|10,20,30|40) = 20);
+      j := 3;
+      ASSERT ((j|10,20,30|40) = 30);
+      j := 100;
+      ASSERT ((j|10,20,30|40) = 40)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/case-clause-2.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 2;
+      ASSERT (CASE INT x = 10; i
+              IN x + 1,
+                 x + 2,
+                 x + 3
+              ESAC = 12)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/case-clause-3.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT days, INT month = 2, year = 2024;
+      days := CASE month
+              IN 31, (year MOD 4 = 0 AND year MOD 100 /= 0 OR year MOD 400 = 0 | 29 | 28),
+                 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ESAC;
+      ASSERT (days = 29)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/case-clause-4.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT day = 3;
+      STRING day name = (day | "MONDAY", "TUESDAY", "WEDNESDAY", "THURSDAY", "FRIDAY", "SATURDAY", "SUNDAY");
+      ASSERT (day name[1] = "W")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/closed-clause-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL pie, my small real := 0.001;
+      PROC my sqrt = (REAL r) REAL: r;
+      BEGIN REAL w := 0, INT i := 1, REAL z = my sqrt (my small real / 2);
+      loop: w := w + 2 / (i * (i + 2));
+            i := i + 4;
+            IF 1/i > z THEN GO TO loop FI;
+            pie := 4 * w
+      END
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/closed-clause-2.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL my small real := 0.001;
+      PROC my sqrt = (REAL r) REAL: r;
+      REAL res = 4 * (REAL w := 0, INT i := 1; REAL z = my sqrt (my small real / 2);
+                      loop: w := w + 2/(i * (i + 2)); i := i + 4;
+                      IF 1/i > z THEN loop FI;
+                      w);
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/collateral-clause-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 10;
+      (i, i + 1, i + 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/collateral-clause-2.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 10;
+      (
+         BEGIN
+            (i + 1, i +:= 1, i + 2)
+         END
+      );
+      ASSERT (i = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/collateral-clause-3.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 10;
+      (
+         i +:= 1;
+         BEGIN
+            (i + 1, (i +:= 1, i + 10, i + 11, SKIP), i + 2)
+         END;
+         i +:= i
+      );
+      ASSERT (i = 24)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/collateral-clause-4.a68
@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN (SKIP,SKIP)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/collateral-clause-5.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x, y, z;
+      (x := 1, y := 2, z := 3);
+      ASSERT (x = 1 AND y = 2 AND z = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/collateral-clause-6.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i;
+      PROC side = INT: (i := 1; i := 2; i);
+      PROC add = (INT ii, INT jj) INT: ii + jj;
+      INT res = add (side, side);
+      # can be 3 or 4 due to collateral evaluation of arguments.  #
+      ASSERT (res = 3 OR res = 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/completer-1.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i;
+      BEGIN (i := 20 EXIT
+cont:        i := 30
+            );
+            i +:= 1
+      END;
+      ASSERT (i = 21)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/completer-10.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 20;
+      REF INT xx := x;
+      REF REF INT xxx;
+      REF INT i := (x := 10; xxx := xx EXIT foo: xxx EXIT bar: xxx := xx);
+      ASSERT (i = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/completer-2.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = (foo;
+               10 EXIT
+foo:           20 EXIT
+bar:           30);
+      ASSERT (i = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/completer-3.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = ((((foo; 10 EXIT foo: 20 EXIT bar: 30))));
+      ASSERT (i = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/completer-4.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := (foo; 10 EXIT foo: 20 EXIT bar: 30);
+      ASSERT (i = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/completer-5.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x;
+      REF INT i := (foo; x := 10 EXIT foo: x := 20 EXIT bar: x := 30);
+      ASSERT (i = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/completer-6.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 20;
+      REF INT i := (foo; x := 10 EXIT foo: x EXIT bar: x := 30);
+      ASSERT (i = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/completer-7.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 20;
+      REF INT i := (x := 10 EXIT foo: x EXIT bar: x := 30);
+      ASSERT (i = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/completer-8.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 20;
+      REF INT i := (x EXIT foo: x EXIT bar: x := 30);
+      ASSERT (i = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/completer-9.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 20;
+      REF INT xx := x;
+      REF INT i := (xx EXIT foo: xx EXIT bar: xx := x);
+      ASSERT (i = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/cond-clause-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 10, x;
+      IF i > 5 THEN x := i FI;
+      ASSERT (x = i)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/cond-clause-2.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 10, x;
+      IF i < 5 THEN x = i FI;
+      ASSERT (x /= i)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/cond-clause-3.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 5;
+      IF i = 5
+      THEN 0
+      ELSE ASSERT (FALSE); 1
+      FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/cond-clause-4.a68
@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper" }  #
+# Declarations in enquiry clause.  #
+(INT i; i := 3 ; i := 2; i /= i | ASSERT (FALSE); 1 | 0)
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/cond-clause-5.a68
@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper" }  #
+# Closed clauses in enquiry clause.  #
+((INT i; (i := 3 ; i := 2); ((i /= i))) | ASSERT (FALSE); 1 | 0)
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/cond-clause-6.a68
@@ -0,0 +1,23 @@
+# { dg-options "-fstropping=upper" }  #
+# Nested conditional clauses  #
+BEGIN
+   INT i = 10;
+   IF i > 5 THEN
+      IF i < 15 THEN
+         IF i > 11 THEN
+            ASSERT (FALSE);
+            1
+         ELSE
+            0
+         FI
+      FI
+   ELSE
+      IF i > 100 THEN
+         ASSERT (FALSE);
+         1
+      ELSE
+         ASSERT (FALSE);
+         1
+      FI
+   FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/cond-clause-7.a68
@@ -0,0 +1,23 @@
+# { dg-options "-fstropping=upper" }  #
+# Nested conditional clauses  #
+BEGIN
+   INT i = 12;
+   IF i > 5 THEN
+      IF i < 15 THEN
+         IF i > 11 THEN
+            0
+         ELSE
+            ASSERT (FALSE);
+            1
+         FI
+      FI
+   ELSE
+      IF i > 100 THEN
+         ASSERT (FALSE);
+         1
+      ELSE
+         ASSERT (FALSE);
+         1
+      FI
+   FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/cond-clause-8.a68
@@ -0,0 +1,20 @@
+# { dg-options "-fstropping=upper" }  #
+# ELIF  #
+BEGIN
+   INT i = 12;
+   IF i > 20 THEN
+      1
+   ELIF i > 5 THEN
+      BEGIN
+         IF FALSE THEN
+            ASSERT (FALSE);
+            1
+         ELSE
+            0
+         FI
+      END
+   ELIF i < 10 THEN
+      ASSERT (FALSE);
+      1
+   FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/cond-clause-9.a68
@@ -0,0 +1,23 @@
+# { dg-options "-fstropping=upper" }  #
+# ELIF with ELSE #
+BEGIN
+   INT i = 12;
+   IF i > 20 THEN
+      1
+   ELIF i > 12 THEN
+      BEGIN
+         IF FALSE THEN
+            ASSERT (FALSE);
+            1
+         ELSE
+            ASSERT (FALSE);
+            1
+         FI
+      END
+   ELIF i < 10 THEN
+      ASSERT (FALSE);
+      1
+   ELSE
+      0
+   FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/conformity-clause-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE DATUM = UNION(INT,REAL,CHAR);
+      DATUM datum := 10;
+      INT i = CASE datum
+              IN (REAL): 2,
+                 (INT i): i + 1,
+                 (CHAR): 3
+              ESAC;
+      ASSERT (i = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/conformity-clause-2.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE DATUM = UNION(INT,REAL,CHAR);
+      DATUM datum := "X";
+      INT i = CASE datum
+              IN (REAL): 2,
+                 (INT val): val + 1
+              OUT INT x = 100;
+                  x + 10
+              ESAC;
+      ASSERT (i = 110)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/conformity-clause-3.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE DATUM = UNION(INT,REAL,CHAR);
+      DATUM datum := 20;
+      INT i = CASE INT i = 10; datum
+              IN (REAL): 2,
+                 (INT val): val + i
+              OUT INT x = 100;
+                  x + 10
+              ESAC;
+      ASSERT (i = 30)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/conformity-clause-4.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []UNION(INT,STRING,REAL) datum = (10, 3.14, "foo", 200);
+      ASSERT (CASE datum[1] IN (INT): 100 ESAC = 100);
+      ASSERT (CASE datum[2] IN (REAL): 200 ESAC = 200);
+      ASSERT (CASE datum[3] IN (STRING): 300 ESAC = 300);
+      ASSERT (CASE datum[4] IN (INT): 400 ESAC = 400)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/conformity-clause-5.a68
@@ -0,0 +1,14 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN UNION(CHAR,BOOL,INT,REAL) cbira := "X";
+      IF CASE cbira
+         IN (BOOL b): b,
+            (INT i): i > 0,
+            (REAL r): r > 0
+         OUT FALSE
+         ESAC
+      THEN # We get here if cbira was not a CHAR and was otherwise
+             TRUE or >0, as the case may be.
+           #
+         ASSERT (FALSE)
+      FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/conformity-clause-6.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN UNION (CHAR,BOOL,REAL) cbra = 3.14, UNION (INT,REAL) ira = 10;
+      IF (cbra | (CHAR): FALSE, (BOOL b): b
+          |: ira | (INT i): i > 0, (REAL r): r > 0)
+      THEN SKIP
+      ELSE ASSERT (FALSE)
+      FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/conformity-clause-7.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN UNION (CHAR,BOOL,REAL) cbra = 3.14, UNION (INT,REAL) ira = -10;
+      IF (cbra | (CHAR): FALSE, (BOOL b): b
+          |: ira | (INT i): i > 0, (REAL r): r > 0)
+      THEN ASSERT (FALSE)
+      FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/conformity-clause-8.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE JORL = STRUCT (UNION(INT,REAL) i, REF JORL next);
+      REF JORL p := HEAP JORL := (10, HEAP JORL := (20.0, NIL));
+      p := HEAP JORL := (30, p);
+      INT num ints := 0, num reals := 0;
+      WHILE REF JORL (p) ISNT NIL
+      DO CASE i OF p IN (INT): num ints +:= 1, (REAL): num reals +:= 1 ESAC;
+         p := next OF p
+      OD;
+      ASSERT (num ints = 2 AND num reals = 1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/conformity-clause-9.a68
@@ -0,0 +1,10 @@
+begin union (int, bool, string) foo = 666;
+      case foo
+      in (union(int,string) bar):
+            case bar
+            in (int i): assert (i = 666),
+               (string s): assert (false)
+            esac,
+         (bool baz): assert (false)
+      esac
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/conj-1.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN COMPL z = 4.0I5.0;
+      CONJ z;
+      LONG COMPL zz = LONG 4.0 I LONG 6.0;
+      CONJ zz;
+      LONG LONG COMPL zzz = LONG LONG 4.0 I LONG LONG 7.0;
+      CONJ zzz;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/cos-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL r = 0.0;
+      LONG REAL rr = LONG 45.0;
+      LONG LONG REAL rrr = LONG LONG 60.0;
+      ASSERT (cos (r) = 1.0);
+      long cos (rr);
+      long long cos (rrr)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/declarer-1.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+# Tests a jump out of the elaboration of a declarer.  #
+BEGIN STRING month = CASE 13
+                     IN "Jan", "Feb","March","April","May","June",
+		        "July","Aug","Sept", "Oct",  "Nov","Dec",
+                        stop
+                     ESAC;
+      ASSERT (FALSE)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/declarer-2.a68
@@ -0,0 +1,6 @@
+begin int n := 1;
+      { The actual-declarer below should be
+        elaborated only once.  }
+      [1: n +:= 1]real a, b;
+      assert (n = 2)
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/deprocedure-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x = 100;
+      PROC foo = INT: (INT i = 10, j = 20; PROC bar = INT: 100; i + j + bar);
+      ASSERT (foo = 130)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/deprocedure-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Procedure variables.  #
+BEGIN INT x = 100;
+      PROC foo := INT: (INT i = 10, j = 20; PROC bar := INT: 100; i + j + bar);
+      ASSERT (foo = 130)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/deref-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      INT res := (REF INT xx := x; xx);
+      ASSERT (res = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/deref-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      REF INT xx := x;
+      x := 20;
+      ASSERT (xx = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/deref-3.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      INT y := 20;
+      REF INT xx := x;
+      CO This makes xx to refer to y
+         REF REF INT := REF INT
+      CO
+      xx := y;
+      y := 30;
+      ASSERT (xx = 30)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/deref-4.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      INT y := 20;
+      REF INT xx := x;
+      # This sets x to the current value of y #
+      REF INT (xx) := y;
+      ASSERT (x = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/deref-5.a68
@@ -0,0 +1,42 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      REF INT xx := x;
+      REF REF INT xxx := xx;
+      ASSERT (x = 10);
+      ASSERT (xx = 10);
+      ASSERT (xxx = 10);
+      ASSERT ((x) = 10);
+      ASSERT ((xx) = 10);
+      ASSERT ((xxx) = 10);
+      ASSERT (x + 1 = 11);
+      ASSERT (xx + 1 = 11);
+      ASSERT (xxx + 1 = 11);
+      ASSERT ((x + 1) = 11);
+      ASSERT ((xx + 1) = 11);
+      ASSERT ((xxx + 1) = 11);
+      ASSERT ((x := x) = 10);
+      ASSERT ((xx := x) = 10);
+      ASSERT ((xxx := xx) = 10);
+      ASSERT ((x := x) + 1 = 11);
+      ASSERT ((xx := x) + 1 = 11);
+      ASSERT ((xxx := xx) + 1 = 11);
+      x := 20;
+      ASSERT (x = 20);
+      ASSERT (xx = 20);
+      ASSERT (xxx = 20);
+      ASSERT ((x) = 20);
+      ASSERT ((xx) = 20);
+      ASSERT ((xxx) = 20);
+      ASSERT (x + 1 = 21);
+      ASSERT (xx + 1 = 21);
+      ASSERT (xxx + 1 = 21);
+      ASSERT ((x + 1) = 21);
+      ASSERT ((xx + 1) = 21);
+      ASSERT ((xxx + 1) = 21);
+      ASSERT ((x := x) = 20);
+      ASSERT ((xx := x) = 20);
+      ASSERT ((xxx := xx) = 20);
+      ASSERT ((x := x) + 1 = 21);
+      ASSERT ((xx := x) + 1 = 21);
+      ASSERT ((xxx := xx) + 1 = 21)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/deref-6.a68
@@ -0,0 +1,48 @@
+# { dg-options "-fstropping=upper" }  #
+# Dereferencing of struct fields.  #
+BEGIN MODE S = STRUCT (REF INT x, REF REF INT xx, REF REF REF INT xxx);
+
+      INT x := 10;
+      REF INT xx := x;
+      REF REF INT xxx := xx;
+
+      S s = (x, xx, xxx);
+
+      ASSERT (x OF s = 10);
+      ASSERT (xx OF s = 10);
+      ASSERT (xxx OF s = 10);
+      ASSERT ((x) = 10);
+      ASSERT ((xx) = 10);
+      ASSERT ((xxx) = 10);
+      ASSERT (x OF s + 1 = 11);
+      ASSERT (xx OF s + 1 = 11);
+      ASSERT (xxx OF s + 1 = 11);
+      ASSERT ((x OF s + 1) = 11);
+      ASSERT ((xx OF s + 1) = 11);
+      ASSERT ((xxx OF s + 1) = 11);
+      ASSERT ((x OF s := x) = 10);
+      ASSERT ((xx OF s := x) = 10);
+      ASSERT ((xxx OF s := xx) = 10);
+      ASSERT ((x OF s := x) + 1 = 11);
+      ASSERT ((xx OF s := x) + 1 = 11);
+      ASSERT ((xxx OF s := xx) + 1 = 11);
+      x OF s := 20;
+      ASSERT (x OF s = 20);
+      ASSERT (xx OF s = 20);
+      ASSERT (xxx OF s = 20);
+      ASSERT ((x) = 20);
+      ASSERT ((xx) = 20);
+      ASSERT ((xxx) = 20);
+      ASSERT (x OF s + 1 = 21);
+      ASSERT (xx OF s + 1 = 21);
+      ASSERT (xxx OF s + 1 = 21);
+      ASSERT ((x OF s + 1) = 21);
+      ASSERT ((xx OF s + 1) = 21);
+      ASSERT ((xxx OF s + 1) = 21);
+      ASSERT ((x OF s := x) = 20);
+      ASSERT ((xx OF s := x) = 20);
+      ASSERT ((xxx OF s := xx) = 20);
+      ASSERT ((x OF s := x) + 1 = 21);
+      ASSERT ((xx OF s := x) + 1 = 21);
+      ASSERT ((xxx OF s := xx) + 1 = 21)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/deref-7.a68
@@ -0,0 +1,48 @@
+# { dg-options "-fstropping=upper" }  #
+# Dereferencing of struct fields.  Version with sub-names.  #
+BEGIN MODE S = STRUCT (INT x, REF INT xx, REF REF INT xxx);
+
+      INT x := 10;
+      REF INT xx := x;
+      REF REF INT xxx := xx;
+
+      S s := (x, xx, xxx);
+
+      ASSERT (x OF s = 10);
+      ASSERT (xx OF s = 10);
+      ASSERT (xxx OF s = 10);
+      ASSERT ((x) = 10);
+      ASSERT ((xx) = 10);
+      ASSERT ((xxx) = 10);
+      ASSERT (x OF s + 1 = 11);
+      ASSERT (xx OF s + 1 = 11);
+      ASSERT (xxx OF s + 1 = 11);
+      ASSERT ((x OF s + 1) = 11);
+      ASSERT ((xx OF s + 1) = 11);
+      ASSERT ((xxx OF s + 1) = 11);
+      ASSERT ((x OF s := x) = 10);
+      ASSERT ((xx OF s := xx) = 10);
+      ASSERT ((xxx OF s := xxx) = 10);
+      ASSERT ((x OF s := x) + 1 = 11);
+      ASSERT ((xx OF s := xx) + 1 = 11);
+      ASSERT ((xxx OF s := xxx) + 1 = 11);
+      x := 20;
+      ASSERT (x OF s = 10);
+      ASSERT (xx OF s = 20);
+      ASSERT (xxx OF s = 20);
+      ASSERT ((x) = 20);
+      ASSERT ((xx) = 20);
+      ASSERT ((xxx) = 20);
+      ASSERT (x OF s + 1 = 11);
+      ASSERT (xx OF s + 1 = 21);
+      ASSERT (xxx OF s + 1 = 21);
+      ASSERT ((x OF s + 1) = 11);
+      ASSERT ((xx OF s + 1) = 21);
+      ASSERT ((xxx OF s + 1) = 21);
+      ASSERT ((x OF s := x) = 20);
+      ASSERT ((xx OF s := xx) = 20);
+      ASSERT ((xxx OF s := xxx) = 20);
+      ASSERT ((x OF s := x) + 1 = 21);
+      ASSERT ((xx OF s := xx) + 1 = 21);
+      ASSERT ((xxx OF s := xxx) + 1 = 21)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/deref-8.a68
@@ -0,0 +1,53 @@
+# { dg-options "-fstropping=upper" }  #
+# Dereferencing of struct fields.  Version with sub-names and
+  explicit assignations instead of initialization in variable declaration.  #
+BEGIN MODE S = STRUCT (INT x, REF INT xx, REF REF INT xxx);
+
+      INT x := 10;
+      REF INT xx := x;
+      REF REF INT xxx := xx;
+
+      S s;
+
+      x OF s := x;
+      xx OF s := xx;
+      xxx OF s := xxx;
+
+      ASSERT (x OF s = 10);
+      ASSERT (xx OF s = 10);
+      ASSERT (xxx OF s = 10);
+      ASSERT ((x) = 10);
+      ASSERT ((xx) = 10);
+      ASSERT ((xxx) = 10);
+      ASSERT (x OF s + 1 = 11);
+      ASSERT (xx OF s + 1 = 11);
+      ASSERT (xxx OF s + 1 = 11);
+      ASSERT ((x OF s + 1) = 11);
+      ASSERT ((xx OF s + 1) = 11);
+      ASSERT ((xxx OF s + 1) = 11);
+      ASSERT ((x OF s := x) = 10);
+      ASSERT ((xx OF s := xx) = 10);
+      ASSERT ((xxx OF s := xxx) = 10);
+      ASSERT ((x OF s := x) + 1 = 11);
+      ASSERT ((xx OF s := xx) + 1 = 11);
+      ASSERT ((xxx OF s := xxx) + 1 = 11);
+      x := 20;
+      ASSERT (x OF s = 10);
+      ASSERT (xx OF s = 20);
+      ASSERT (xxx OF s = 20);
+      ASSERT ((x) = 20);
+      ASSERT ((xx) = 20);
+      ASSERT ((xxx) = 20);
+      ASSERT (x OF s + 1 = 11);
+      ASSERT (xx OF s + 1 = 21);
+      ASSERT (xxx OF s + 1 = 21);
+      ASSERT ((x OF s + 1) = 11);
+      ASSERT ((xx OF s + 1) = 21);
+      ASSERT ((xxx OF s + 1) = 21);
+      ASSERT ((x OF s := x) = 20);
+      ASSERT ((xx OF s := xx) = 20);
+      ASSERT ((xxx OF s := xxx) = 20);
+      ASSERT ((x OF s := x) + 1 = 21);
+      ASSERT ((xx OF s := xx) + 1 = 21);
+      ASSERT ((xxx OF s := xxx) + 1 = 21)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/div-int-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 10;
+      LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+      ASSERT (i / 2 = 5.0);
+      ASSERT (ii / LONG 2 = LONG 5.0);
+      ASSERT (iii / LONG LONG 2 = LONG LONG 5.0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/divab-real-1.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL r := 3.14;
+      r DIVAB 2.0;
+      r /:= 2.0;
+      LONG REAL rr := LONG 3.14;
+      rr DIVAB LONG 2.0;
+      rr /:= LONG 2.0;
+      LONG LONG REAL rrr := LONG LONG 3.14;
+      rrr DIVAB LONG LONG 2.0;
+      rrr /:= LONG LONG 2.0
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/elem-bits-1.a68
@@ -0,0 +1,18 @@
+# { dg-options "-fstropping=upper" }  #
+# ELEM for SIZETY BITS #
+BEGIN BITS b = 2r1010;
+      ASSERT ((bits width - 1) ELEM b);
+      ASSERT (NOT ((bits width - 2) ELEM b));
+      LONG BITS bb = LONG 2r1010;
+      ASSERT ((long bits width - 1) ELEM bb);
+      ASSERT (NOT ((long bits width - 2) ELEM bb));
+      LONG LONG BITS bbb = LONG LONG 2r1010;
+      ASSERT ((long long bits width - 1) ELEM bbb);
+      ASSERT (NOT ((long long bits width - 2) ELEM bbb));
+      SHORT BITS ss = SHORT 2r1010;
+      ASSERT ((short bits width - 1) ELEM ss);
+      ASSERT (NOT ((short bits width - 2) ELEM ss));
+      SHORT SHORT BITS sss = SHORT SHORT 2r1010;
+      ASSERT ((short short bits width - 1) ELEM sss);
+      ASSERT (NOT ((short short bits width - 2) ELEM sss))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/elems-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (ELEMS "foo" = 3);
+      ASSERT (ELEMS "" = 0);
+      ASSERT (1 ELEMS "foo" = 3);
+      ASSERT (1 ELEMS "" = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/elems-2.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# Flat and ultra-flat multiples.  #
+BEGIN [3,10:3]INT arr;
+      ASSERT (2 ELEMS arr = 0);
+      [1:0]INT arr2;
+      ASSERT (ELEMS arr2 = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/entier-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL x = 3.14, y = 3.80;
+      LONG REAL xx = LONG 3.14, yy = LONG 3.80;
+      LONG LONG REAL xxx = LONG LONG 3.14, yyy = LONG LONG 3.80;
+      ASSERT (ENTIER x = 3 AND ENTIER y = 3);
+      ASSERT (ENTIER xx = LONG 3 AND ENTIER yy = LONG 3);
+      ASSERT (ENTIER xxx = LONG LONG 3 AND ENTIER yyy = LONG LONG 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/environment-enquiries-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+# Environment enquiries for SIZETY INTs #
+BEGIN ASSERT (max int /= 0);
+      (INT max int = 10; ASSERT (max int = 10));
+      ASSERT (long max int >= LENG max int);
+      ASSERT (long long max int >= LENG long max int);
+      ASSERT (min int /= 0);
+      ASSERT (long min int <= LENG min int);
+      ASSERT (long long min int <= LENG long min int)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/environment-enquiries-2.a68
@@ -0,0 +1,12 @@
+# { dg-options "-fstropping=upper" }  #
+# Environment enquiries for SIZETY REALs #
+BEGIN ASSERT (max real /= 0.0);
+      ASSERT (long max real >= LENG max real);
+      ASSERT (long long max real >= LENG long max real);
+      ASSERT (min real /= 0.0);
+      ASSERT (long min real <= LENG min real);
+      ASSERT (long long min real <= LENG long min real);
+      ASSERT (small real > 0.0);
+      ASSERT (long small real > LONG 0.0);
+      ASSERT (long long small real > LONG LONG 0.0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/environment-enquiries-3.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+# Environment enquiries for SIZETY BITS #
+BEGIN ASSERT (bits width > 0);
+      ASSERT (long bits width >= bits width);
+      ASSERT (long long bits width >= long bits width);
+      ASSERT (short bits width <= bits width);
+      ASSERT (short short bits width <= short bits width)
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/environment-enquiries-4.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# Environment enquiries for pi constants.  #
+BEGIN ASSERT (pi > 3.0 AND pi < 4.0);
+      ASSERT (long pi > LONG 3.0 AND long pi < LONG 4.0);
+      ASSERT (long long pi > LONG LONG 3.0 AND long long pi < LONG LONG 4.0)
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/environment-enquiries-5.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Environment enquiries for certain particular characters.  #
+BEGIN ASSERT (null character /= blank);
+      ASSERT (max abs char = ABS 16r10ffff)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/environment-enquiries-6.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# Environment enquiries for SIZETY BITs #
+BEGIN ASSERT (max bits /= 10r0);
+      # XXX use LENG max bits below #
+      ASSERT (long max bits >= LONG 10r0);
+      ASSERT (long long max bits >= LONG LONG 10r0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/environment-enquiries-7.a68
@@ -0,0 +1,15 @@
+# { dg-options "-fstropping=upper" }  #
+# Environment enquiries for widths #
+BEGIN ASSERT (int width > 0);
+      ASSERT (long int width > 0);
+      ASSERT (long long int width > 0);
+      ASSERT (short int width > 0);
+      ASSERT (short short int width > 0);
+      ASSERT (real width > 0);
+      ASSERT (long real width > 0);
+      ASSERT (long long real width > 0)
+CO      exp width;
+        long exp width;
+        long long exp width;
+CO
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/environment-enquiries-8.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (flip = "T");
+      ASSERT (flop = "F");
+      ASSERT (error char = "*");
+      ASSERT (ABS invalid char = ABS 16rfffd)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/eq-bits-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN BITS b, LONG BITS bb = LONG 16rff,  LONG LONG BITS bbb;
+      SHORT BITS ss = SHORT 16rff, SHORT SHORT BITS sss;
+      ASSERT (b = 2r0);
+      ASSERT (bb EQ LONG 8r377);
+      ASSERT (bbb = LONG LONG 8r0);
+      ASSERT (ss EQ SHORT 8r377);
+      ASSERT (sss = SHORT SHORT 8r0)
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/eq-char-char-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT ("a" = "a")
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/eq-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 12;
+      LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12;
+      SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12;
+      ASSERT (12 = i);
+      ASSERT (ii = LONG 12);
+      ASSERT (iii = LONG LONG 12);
+      ASSERT (s = SHORT 12);
+      ASSERT (ss = SHORT SHORT 12)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/eq-string-1.a68
@@ -0,0 +1,16 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRING foo = "foo", bar = "bar", quux = "quux";
+      # =  #
+      ASSERT ("" = "");
+      ASSERT ("foo" = foo);
+      ASSERT (NOT (foo = bar));
+      ASSERT (NOT (foo = quux));
+      ASSERT (NOT (quux = foo));
+      # EQ  #
+      ASSERT ("" EQ "");
+      ASSERT ("foo" EQ foo);
+      ASSERT (NOT (foo EQ bar));
+      ASSERT (NOT (foo EQ quux));
+      ASSERT (NOT (quux EQ foo))
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/eq-string-stride-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]CHAR matrix = (("1", "2", "3"),
+                        ("4", "5", "6"),
+                        ("7", "8", "9"));
+      ASSERT (matrix[1:3,2] = "258")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/execute.exp
@@ -0,0 +1,37 @@
+# Copyright (C) 2024 Free Software Foundation, Inc.
+
+# 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/>.
+
+# Execute tests, torture testing.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+load_lib algol68-torture.exp
+load_lib torture-options.exp
+
+torture-init
+set-torture-options $TORTURE_OPTIONS
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.a68]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+    algol68-torture-execute $testcase
+    set algol68_compile_args ""
+}
+
+torture-finish
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/factorial-1.a68
@@ -0,0 +1,170 @@
+# { dg-options "-fstropping=upper" }  #
+# The Most Contrived Factorial Program
+  By John P. Baker
+  University of Bristol.
+
+  Published in the Algol Bulletin 42.
+  http://jemarch.net/algol-bulletin-42.pdf
+
+  Version adapted for GCC.
+#
+
+BEGIN INT one = 1, two = 2, three = 3, four = 4, five = 5,
+          six = 6, seven = 7, eight = 8, nine = 9, ten = 10,
+          eleven = 11, twelve = 12;
+      INT a = one;
+      PRIO ME=5, LOVE=7, MY=7, LORDS=7, LADIES=7,
+           PIPERS=7, DRUMMERS=7, MAIDS=7, SWANS=7, GEESE=7,
+           GOLD=7, COLLY=7, FRENCH=7, TURTLE=7, PARTRIDGE=6;
+      BOOL sent to := TRUE;
+      OP THE = (BOOL a) BOOL: a,
+         TWELFTH = (INT a) BOOL: a = twelve,
+         ELEVENTH = (INT a) BOOL: a = eleven,
+         TENTH = (INT a) BOOL: a = ten,
+         NINTH = (INT a) BOOL: a = nine,
+         EIGHTH = (INT a) BOOL: a = eight,
+         SEVENTH = (INT a) BOOL: a = seven,
+         SIXTH = (INT a) BOOL: a = six,
+         FIFTH = (INT a) BOOL: a = five,
+         FOURTH = (INT a) BOOL: a = four,
+         THIRD = (INT a) BOOL: a = three,
+         SECOND = (INT a) BOOL: a = two,
+         FIRST = (INT a) BOOL: a = one;
+      OP ME = (BOOL a, INT b) VOID: SKIP; # XXX when transput done (a|print(b)) #
+      OP LOVE = (BOOL a, b) BOOL: (a|b|FALSE),
+         MY = (BOOL a, b) BOOL: a LOVE b;
+      OP AND = (INT a) INT: a;
+      MODE DATE = STRUCT (INT day, month);
+      LOC DATE christmas := (25, 12);
+      OP LORDS = (INT a, b) INT: a * b,
+         LADIES = (INT a, b) INT: a * b,
+         PIPERS = (INT a, b) INT: a * b,
+         DRUMMERS = (INT a, b) INT: a * b,
+         MAIDS = (INT a, b) INT: a * b,
+         SWANS = (INT a, b) INT: a * b,
+         GEESE = (INT a, b) INT: a * b,
+         GOLD = (INT a, b) INT: a * b,
+         COLLY = (INT a, b) INT: a * b,
+         FRENCH = (INT a, b) INT: a * b,
+         TURTLE = (INT a, b) INT: a * b;
+      OP LEAPING = (INT a) INT: a,
+         DANCING = (INT a) INT: a,
+         PIPING = (INT a) INT: a,
+         DRUMMING = (INT a) INT: a,
+         MILKING = (INT a) INT: a,
+         SWIMMING = (INT a) INT: a,
+         LAYING = (INT a) INT: a,
+         RINGS = (INT a) INT: a,
+         BIRDS = (INT a) INT: a,
+         HENS = (INT a) INT: a,
+         DOVES = (INT a) INT: a;
+      OP PARTRIDGE = (INT a, b) INT: a + b;
+      INT in a pear tree = 0;
+
+      # Now we are ready...  #
+
+       THE FIRST day OF christmas MY TRUE LOVE sent to ME
+      a PARTRIDGE in a pear tree;
+
+       THE SECOND day OF christmas MY TRUE LOVE sent to ME
+      two TURTLE DOVES AND
+      a PARTRIDGE in a pear tree;
+
+       THE THIRD day OF christmas MY TRUE LOVE sent to ME
+      three FRENCH HENS
+      two TURTLE DOVES AND
+      a PARTRIDGE in a pear tree;
+
+       THE FOURTH day OF christmas MY TRUE LOVE sent to ME
+      four COLLY BIRDS
+      three FRENCH HENS
+      two TURTLE DOVES AND
+      a PARTRIDGE in a pear tree;
+
+       THE FIFTH day OF christmas MY TRUE LOVE sent to ME
+      five GOLD RINGS
+      four COLLY BIRDS
+      three FRENCH HENS
+      two TURTLE DOVES AND
+      a PARTRIDGE in a pear tree;
+
+       THE SIXTH day OF christmas MY TRUE LOVE sent to ME
+      six GEESE LAYING
+      five GOLD RINGS
+      four COLLY BIRDS
+      three FRENCH HENS
+      two TURTLE DOVES AND
+      a PARTRIDGE in a pear tree;
+
+       THE SEVENTH day OF christmas MY TRUE LOVE sent to ME
+      seven SWANS SWIMMING
+      six GEESE LAYING
+      five GOLD RINGS
+      four COLLY BIRDS
+      three FRENCH HENS
+      two TURTLE DOVES AND
+      a PARTRIDGE in a pear tree;
+
+       THE EIGHTH day OF christmas MY TRUE LOVE sent to ME
+      eight MAIDS MILKING
+      seven SWANS SWIMMING
+      six GEESE LAYING
+      five GOLD RINGS
+      four COLLY BIRDS
+      three FRENCH HENS
+      two TURTLE DOVES AND
+      a PARTRIDGE in a pear tree;
+
+       THE NINTH day OF christmas MY TRUE LOVE sent to ME
+      nine DRUMMERS DRUMMING
+      eight MAIDS MILKING
+      seven SWANS SWIMMING
+      six GEESE LAYING
+      five GOLD RINGS
+      four COLLY BIRDS
+      three FRENCH HENS
+      two TURTLE DOVES AND
+      a PARTRIDGE in a pear tree;
+
+       THE TENTH day OF christmas MY TRUE LOVE sent to ME
+      ten PIPERS PIPING
+      nine DRUMMERS DRUMMING
+      eight MAIDS MILKING
+      seven SWANS SWIMMING
+      six GEESE LAYING
+      five GOLD RINGS
+      four COLLY BIRDS
+      three FRENCH HENS
+      two TURTLE DOVES AND
+      a PARTRIDGE in a pear tree;
+
+       THE ELEVENTH day OF christmas MY TRUE LOVE sent to ME
+      eleven LADIES DANCING
+      ten PIPERS PIPING
+      nine DRUMMERS DRUMMING
+      eight MAIDS MILKING
+      seven SWANS SWIMMING
+      six GEESE LAYING
+      five GOLD RINGS
+      four COLLY BIRDS
+      three FRENCH HENS
+      two TURTLE DOVES AND
+      a PARTRIDGE in a pear tree;
+
+       THE TWELFTH day OF christmas MY TRUE LOVE sent to ME
+      twelve LORDS LEAPING
+      eleven LADIES DANCING
+      ten PIPERS PIPING
+      nine DRUMMERS DRUMMING
+      eight MAIDS MILKING
+      seven SWANS SWIMMING
+      six GEESE LAYING
+      five GOLD RINGS
+      four COLLY BIRDS
+      three FRENCH HENS
+      two TURTLE DOVES AND
+      a PARTRIDGE in a pear tree;
+
+   SKIP
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/flat-assignation-1.a68
@@ -0,0 +1,7 @@
+{ Assigning to the flexible name replaces the descriptor
+  as well as the elements.  }
+begin [10:0]int flat1;
+      flex[10:-10]int flat2;
+      flat2 := flat1;
+      assert (UPB flat2 = 0 AND LWB flat2 = 10)
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/flat-assignation-2.a68
@@ -0,0 +1,8 @@
+{ Assigning to the flexible name replaces the descriptor
+  as well as the elements.  }
+begin [1:20,10:0]int flat1;
+      flex[100:200,10:-10]int flat2;
+      flat2 := flat1;
+      assert (1 UPB flat2 = 20 AND 1 LWB flat2 = 1);
+      assert (2 UPB flat2 = 0  AND 2 LWB flat2 = 10)
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/flex-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN FLEX[3]INT list := (1,2,3);
+      list[2] := 20;
+      ASSERT (list[2] = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/flex-2.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# Rowing to flexible rows.  #
+BEGIN FLEX[]INT list = 10;
+      ASSERT (list[1] = 10);
+      FLEX[,]INT table = 10;
+      ASSERT (table[1,1] = 10)
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/flex-3.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# Slicing flexible names.  #
+BEGIN FLEX[]INT list = (1,2,3);
+      FLEX[]INT sliced = list[2:3];
+      ASSERT (LWB sliced = 1 AND UPB sliced = 2);
+      ASSERT (sliced[1] = 2 AND sliced[2] = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/flex-4.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Rowing to flexible rows.  #
+BEGIN FLEX[3]INT list := (1,2,3);
+      list := (10,20,30,40);
+      ASSERT (list[4] = 40)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/flex-5.a68
@@ -0,0 +1,12 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN FLEX[1:0]INT a;
+      ASSERT (LWB a = 1 AND UPB a = 0 AND ELEMS a = 0);
+      a := (1,2,3);
+      ASSERT (LWB a = 1 AND UPB a = 3 AND a[1] = 1 AND a[2] = 2 AND a[3] = 3);
+      a := (10,a[2],a[3]);
+      ASSERT (LWB a = 1 AND UPB a = 3 AND a[1] = 10 AND a[2] = 2 AND a[3] = 3);
+      a := 100;
+      ASSERT (LWB a = 1 AND UPB a = 1 AND a[1] = 100);
+      a := ();
+      ASSERT (LWB a = 1 AND UPB a = 0 AND ELEMS a = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/formula-1.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN OP JORL = (INT a, b) INT: a + b;
+      OP JORL = (REAL a, b) REAL: a + b;
+      OP JORL = ([]CHAR s) INT: ELEMS s;
+      PRIO JORL = 6;
+      ASSERT (10 JORL 20 = 30);
+      ASSERT (REAL r = 3.14 JORL REAL (1); r > 4.13 AND r < 4.15);
+      ASSERT (JORL "foo" = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/formula-2.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i;
+      PROC side = INT: (i := 1; i := 2; i);
+      INT res = side + side;
+      # Can be either due to collateral elaboration in the formula above.  #
+      ASSERT (res = 3 OR res = 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/fsize-1.a68
@@ -0,0 +1,2 @@
+begin assert (fsize (-1) = - long long 1)
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/ge-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 12;
+      LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12;
+      SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12;
+      ASSERT (i >= 10);
+      ASSERT (ii GE LONG 10);
+      ASSERT (iii >= LONG LONG 12);
+      ASSERT (s >= SHORT 12);
+      ASSERT (ss >= SHORT SHORT 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/ge-string-stride-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]CHAR matrix = (("1", "0", "1"),
+                        ("4", "0", "4"),
+                        ("7", "0", "7"));
+      ASSERT (matrix[1:3,1] >= matrix[1:3,3]);
+      ASSERT (("1","4","7") >= matrix[1:3,3])
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-flex-1.a68
@@ -0,0 +1,10 @@
+begin flex[10:-10]int je;
+      int num_fields = 3;
+      assert (UPB je = -10 AND LWB je = 10 AND ELEMS je = 0);
+
+      [1:num_fields][1:num_fields]string fields;
+      for i to num_fields
+      do for j to num_fields
+         do assert (fields[i][j] = "") od
+      od
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-heap-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT jorl;
+      REF INT var = HEAP INT;
+      var := jorl := 10;
+      ASSERT (var = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-heap-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT jorl;
+      REF INT var := HEAP INT;
+      var := jorl := 10;
+      ASSERT (var = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-heap-3.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT jorl;
+      INT var := HEAP INT := 15; # The generated name goes away #
+      ASSERT (var = 15)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-heap-bool-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REF BOOL x = HEAP BOOL;
+      ASSERT (x = FALSE);
+      x := TRUE;
+      ASSERT (x = TRUE)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-heap-int-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REF INT x = HEAP INT := 4;
+      ASSERT (x = 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-heap-real-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REF REAL x = HEAP REAL := 4;
+      ASSERT (x > 3.9 AND x < 4.1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-heap-struct-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN HEAP STRUCT(INT i, REAL r) foo;
+      ASSERT (i OF foo = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-heap-struct-2.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN HEAP STRUCT([10]INT i, REAL r) foo;
+      FOR i FROM LWB i OF foo TO UPB i OF foo
+      DO ASSERT ((i OF foo)[i] = 0) OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-heap-struct-3.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN HEAP STRUCT([10]INT i, STRING s) foo;
+      FOR i FROM LWB i OF foo TO UPB i OF foo
+      DO ASSERT ((i OF foo)[i] = 0) OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-loc-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT jorl;
+      REF INT var = LOC INT;
+      var := jorl := 10;
+      ASSERT (var = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-loc-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT jorl;
+      REF INT var := LOC INT;
+      var := jorl := 10;
+      ASSERT (var = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-loc-3.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT jorl;
+      INT var := LOC INT := 15; # The generated name goes away #
+      ASSERT (var = 15)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-loc-4.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE NODE = STRUCT (INT code, REF NODE next);
+
+      NODE top := (10, NIL);
+      next OF top := LOC NODE := (20, NIL);
+      ASSERT (code OF top = 10);
+      ASSERT (code OF next OF top = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-multiple-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE JORL = [(INT x; x + 1)]INT;
+      JORL xx;
+      ASSERT (ELEMS xx = 1 AND xx[1] = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-union-1.a68
@@ -0,0 +1,17 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN UNION(INT,REAL,[]INT,CHAR) datux;
+      ASSERT (CASE datux
+              IN (INT): 10,
+                 (REAL): 20,
+                 (CHAR): 30,
+                 ([]INT): 40
+              ESAC = 0);
+      []INT ja = (1,2,3);
+      datux := ja;
+      ASSERT (CASE datux
+              IN (INT): 10,
+                 (REAL): 20,
+                 (CHAR): 30,
+                 ([]INT): 40
+              ESAC = 40)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-union-2.a68
@@ -0,0 +1,20 @@
+# { dg-options "-fstropping=upper" }  #
+# pr UPPER pr  #
+BEGIN [10]UNION(INT,REAL,[]INT,CHAR) datux;
+      FOR i FROM LWB datux TO UPB datux
+      DO ASSERT (CASE datux[i]
+                 IN (INT): 10,
+                    (REAL): 20,
+                    (CHAR): 30,
+                    ([]INT): 40
+                 ESAC = 0);
+         []INT ja = (1,2,3);
+         datux[i] := ja;
+         ASSERT (CASE datux[i]
+                 IN (INT): 10,
+                    (REAL): 20,
+                    (CHAR): 30,
+                    ([]INT): 40
+                 ESAC = 40)
+      OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gen-union-3.a68
@@ -0,0 +1,14 @@
+# { dg-options "-fstropping=upper" }  #
+# An union generated from SKIP has -1 as overhead.  #
+BEGIN MODE JSONVAL = UNION (JSONOBJ,JSONSTR),
+           JSONSTR = STRING,
+           JSONOBJ = STRUCT (REF JSONFLD fields),
+           JSONFLD = STRUCT (JSONVAL value, REF JSONFLD next);
+
+      JSONFLD fields;
+      ASSERT (CASE value OF fields
+              IN (JSONSTR s): "string",
+                 (JSONOBJ o): "object"
+              OUT "fuckyou"
+              ESAC = "fuckyou")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/goto-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 0;
+beg:  IF (i < 5)
+      THEN i +:= 1;
+           GOTO beg
+      FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/goto-2.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN GOTO end;
+      ASSERT(FALSE);
+end:  SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/goto-3.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN
+   INT i := 0;
+   beginning:
+   IF (i < 5) THEN
+      i +:= 1;
+      GO TO beginning
+   FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/goto-4.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN
+   INT i := 0;
+   beginning:
+   IF (i < 5) THEN
+      i +:= 1;
+      beginning
+   FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/goto-5.a68
@@ -0,0 +1,20 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC is prime = (INT m) BOOL:
+      BEGIN IF m < 2
+            THEN puts ("program terminated because m is less than 2\n");
+                 GOTO stop
+            FI;
+
+            BOOL factor found := NOT (ODD m OR m = 2);
+            FOR i FROM 3 BY 2 TO m - 1 WHILE NOT factor found
+            DO factor found := m MOD i = 0 OD;
+            factor found
+      END;
+
+      ASSERT (is prime (1));
+      ASSERT (is prime (3));
+      ASSERT (is prime (71));
+      ASSERT (is prime (97));
+      is prime (0);
+      ASSERT (FALSE) # Should jump to stop in the standard postlude.  #
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gt-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 12;
+      LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12;
+      SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12;
+      ASSERT (i > 10);
+      ASSERT (ii GT LONG 10);
+      ASSERT (iii > LONG LONG 10);
+      ASSERT (s > SHORT 10);
+      ASSERT (ss > SHORT SHORT 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/gt-string-stride-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]CHAR matrix = (("1", "0", "1"),
+                        ("4", "0", "4"),
+                        ("7", "0", "6"));
+      ASSERT (matrix[1:3,1] > matrix[1:3,3]);
+      ASSERT (("1","4","7") > matrix[1:3,3])
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/i-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN COMPL z = 4I5;
+      LONG COMPL zz = LONG 4 I LONG 6;
+      LONG LONG COMPL zzz = LONG LONG 4 I LONG LONG7;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/i-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN COMPL z = 4.0I5.0;
+      LONG COMPL zz = LONG 4.0 I LONG 6.0;
+      LONG LONG COMPL zzz = LONG LONG 4.0 I LONG LONG 7.0;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identification-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC a = REAL: b := c;
+      REAL b := 1, c := 2;
+      REAL x := a;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identification-2.a68
@@ -0,0 +1,14 @@
+# { dg-options "-fstropping=upper" }  #
+# The identification of c in the assignation marked with XXX works.
+  In some Algol 68 systems the assignation may fail or result in UB,
+  because the storage of the REF REAL c doesn't exist yet.  In GNU
+  Algol 68 this works and the value yielded by c is guaranteed to be
+  zero.
+#
+
+BEGIN REAL b;
+      b := c; # XXX #
+      ASSERT (b = 0);
+      REAL c;
+      c := b
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      REF INT xx = x := 20;
+      ASSERT (xx = 20);
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      REF INT xx = x;
+      ASSERT (xx = 10);
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-3.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      REF INT xx = (x := 20);
+      ASSERT (xx = 20);
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-4.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      REF INT xx = ((x));
+      ASSERT (xx = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-5.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE FOO = STRUCT (STRING s, INT i);
+      FOO f1 = ("foo", 10);
+      ASSERT (i OF f1 = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-multiple-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT foo = (1,2,3);
+      ASSERT (ELEMS foo = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-multiple-2.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [][]INT foo = ((1,2,3),(4,5,6));
+      ASSERT (ELEMS foo = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-multiple-3.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [3]INT a := (1,2,3);
+      REF[]INT nn = a; # No copy happens here.  #
+      nn[1] := 200;
+      ASSERT (a[1] = 200)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-multiple-5.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [:]INT foo = (1,2,3);
+      ASSERT (ELEMS foo = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT a = ();
+      ASSERT (UPB a = 0);
+      ASSERT (LWB a = 1);
+      ASSERT (ELEMS a = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-2.a68
@@ -0,0 +1,12 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,,]INT a = ();
+      ASSERT (1 UPB a = 0);
+      ASSERT (1 LWB a = 1);
+      ASSERT (1 ELEMS a = 0);
+      ASSERT (2 UPB a = 0);
+      ASSERT (2 LWB a = 1);
+      ASSERT (2 ELEMS a = 0);
+      ASSERT (3 UPB a = 0);
+      ASSERT (3 LWB a = 1);
+      ASSERT (3 ELEMS a = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-3.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC foo = ([]INT a) VOID: (ASSERT (ELEMS a = 0));
+      foo ([]INT())
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-4.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC foo = ([]INT a) VOID: (ASSERT (LWB a = 1 AND UPB a = 0 AND ELEMS a = 0));
+      foo (())
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/identity-declaration-struct-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+# An identity declaration shall make a copy of the struct value being
+  ascribed.  #
+BEGIN MODE FOO = STRUCT (STRING s, INT n);
+      FOO f1 := ("foo", 10);
+      FOO f2 = f1;
+      f1 := ("bar", 20);
+      ASSERT (n OF f1 = 20);
+      ASSERT (n OF f2 = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/infinity-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN infinity;
+      minus infinity
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/le-ge-bits-1.a68
@@ -0,0 +1,17 @@
+# { dg-options "-fstropping=upper" }  #
+# <= and => for SIZETY BITS #
+BEGIN ASSERT (16rff <= 16rffff);
+      ASSERT (2r101 LE 2r111);
+      ASSERT (2r111 >= 2r101);
+      ASSERT (16rffff GE 16rff);
+
+      ASSERT (LONG 16rff <= LONG 16rffff);
+      ASSERT (LONG 2r101 LE LONG 2r111);
+      ASSERT (LONG 2r111 >= LONG 2r101);
+      ASSERT (LONG 16rffff GE LONG 16rff);
+
+      ASSERT (LONG LONG 16rff <= LONG LONG 16rffff);
+      ASSERT (LONG LONG 2r101 LE LONG LONG 2r111);
+      ASSERT (LONG LONG 2r111 >= LONG LONG 2r101);
+      ASSERT (LONG LONG 16rffff GE LONG LONG 16rff)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/le-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 12;
+      LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12;
+      SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12;
+      ASSERT (i <= 13);
+      ASSERT (ii LE LONG 13);
+      ASSERT (iii <= LONG LONG 13);
+      ASSERT (s <= SHORT 12);
+      ASSERT (ss <= SHORT SHORT 13)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/le-string-stride-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]CHAR matrix = (("1", "Z", "1"),
+                        ("4", "Y", "4"),
+                        ("7", "X", "9"));
+      ASSERT (matrix[1:3,1] <= matrix[1:3,3]);
+      ASSERT (("1","4","9") <= matrix[1:3,3])
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/leng-shorten-bits-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# SHORTEN and LENG on SIZETY BITS #
+BEGIN ASSERT (LENG 16rff = LONG 16rff);
+      ASSERT (SHORTEN LONG 16rffff = 16rffff);
+      ASSERT (LENG LONG 16rffff = LONG LONG 16rffff);
+      ASSERT (SHORTEN LONG LONG 16rffff = LONG 16rffff)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/leng-shorten-ints-1.a68
@@ -0,0 +1,27 @@
+# { dg-options "-fstropping=upper" }  #
+# Environment enquiries for SIZETY INTs #
+BEGIN # LENG  #
+      (SHORT SHORT INT iii = short short max int; ASSERT (LENG iii = LENG short short max int));
+      (SHORT INT ii = short max int; ASSERT (LENG ii = LENG short max int));
+      (INT i = max int; ASSERT (LENG i = LENG max int));
+      (LONG INT ii = long max int; ASSERT (LENG ii = LENG long max int));
+      # SHORTEN  #
+      (SHORT INT i = SHORT 10; SHORT SHORT INT ii = SHORT SHORT 100; ASSERT (ii + SHORTEN i = SHORT SHORT 110));
+      IF int shorths > 2
+      THEN (SHORT INT ii = LENG short short max int - SHORT 2;
+            ASSERT (SHORTEN ii = short short max int - SHORT SHORT 2));
+           (SHORT INT ii = LENG short short max int + SHORT 1; ASSERT (SHORTEN ii = short short max int));
+           (SHORT INT ii = LENG short short min int - SHORT 1; ASSERT (SHORTEN ii = short short min int))
+      FI;
+      (INT i = LENG short max int - 2; ASSERT (SHORTEN i = SHORTEN max int - SHORT 2));
+      (INT i = LENG short max int + 1; ASSERT (SHORTEN i = SHORTEN max int));
+      (INT i = LENG short min int - 1; ASSERT (SHORTEN i = SHORTEN min int));
+      (LONG INT ii = LENG max int - LONG 2; ASSERT (SHORTEN ii = max int - 2));
+      (LONG INT ii = LENG max int + LONG 1; ASSERT (SHORTEN ii = max int));
+      (LONG INT ii = LENG min int - LONG 1; ASSERT (SHORTEN ii = min int));
+      IF int lengths > 2
+      THEN (LONG LONG INT ii = LENG long max int - LONG LONG 2; ASSERT (SHORTEN ii = long max int - LONG 2));
+           (LONG LONG INT ii = LENG long max int + LONG LONG 1; ASSERT (SHORTEN ii = long max int));
+           (LONG LONG INT ii = LENG long min int - LONG LONG 1; ASSERT (SHORTEN ii = long min int))
+      FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/leng-shorten-reals-1.a68
@@ -0,0 +1,17 @@
+# { dg-options "-fstropping=upper" }  #
+# Environment enquiries for SIZETY REALs #
+BEGIN # LENG  #
+      (REAL i = max real; ASSERT (LENG i = LENG max real));
+      (LONG REAL ii = long max real; ASSERT (LENG ii = LENG long max real));
+
+      # SHORTEN  #
+      (LONG REAL ii = LENG max real - LONG 2.0; ASSERT (SHORTEN ii = max real - 2.0));
+      (LONG REAL ii = LENG max real + LONG 1.0; ASSERT (SHORTEN ii = max real));
+      (LONG REAL ii = LENG min real - LONG 1.0; ASSERT (SHORTEN ii = min real));
+      IF (long long max real > LENG long max real)
+      THEN (LONG LONG REAL ii = LENG long max real - LONG LONG 2.0;
+            ASSERT (SHORTEN ii = long max real - LONG 2.0));
+           (LONG LONG REAL ii = LENG long max real + LONG LONG 1.0; ASSERT (SHORTEN ii = long max real));
+           (LONG LONG REAL ii = LENG long min real - LONG LONG 1.0; ASSERT (SHORTEN ii = long min real))
+      FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/lengths-shorths-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (int lengths > 0);
+      ASSERT (int shorths > 0);
+      ASSERT (bits lengths > 0);
+      ASSERT (bits shorths > 0);
+      ASSERT (real lengths > 0);
+      ASSERT (real shorths > 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/lisp-1.a68
@@ -0,0 +1,25 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT num ints := 0, num chars := 0;
+      PROC collect stats = (REF CONS tree) VOID:
+      BEGIN REF CONS e := tree;
+            WHILE REF CONS (e) ISNT NIL
+            DO CASE car OF e
+               IN (CHAR c): num chars +:= 1,
+                  (INT): num ints +:= 1,
+                  (REF CONS s): collect stats (s)
+               ESAC;
+               e := cdr OF e
+            OD
+      END;
+      MODE ATOM = UNION (CHAR, INT);
+      MODE CONS = STRUCT (UNION (ATOM, REF CONS) car, REF CONS cdr);
+      PROC list = ([]UNION (ATOM, REF CONS) item) REF CONS:
+      BEGIN REF CONS a := NIL;
+            FOR i FROM UPB item BY -1 TO 1
+            DO a := HEAP CONS := (item[i], a) OD;
+            a
+      END;
+      REF CONS expression := list (("X", "+", list (("Y", "x", 2))));
+      collect stats (expression);
+      ASSERT (num ints = 1 AND num chars = 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/lisp-2.a68
@@ -0,0 +1,21 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT num constants := 0, num vars := 0, num operators := 0;
+      PROC collect stats = (REF EXPRESSION expr) VOID:
+      BEGIN CASE left OF expr
+            IN (INT): num constants +:= 1,
+               (CHAR): num vars +:= 1,
+               (REF EXPRESSION s): collect stats (s)
+            ESAC;
+            num operators +:= 1;
+            CASE right OF expr
+            IN (INT): num constants +:= 1,
+               (CHAR): num vars +:= 1,
+               (REF EXPRESSION s): collect stats (s)
+            ESAC
+      END;
+      MODE OPERAND = UNION (CHAR,INT,REF EXPRESSION),
+           EXPRESSION = STRUCT (OPERAND left, CHAR operator, OPERAND right);
+      REF EXPRESSION expression := HEAP EXPRESSION := ("X", "+", HEAP EXPRESSION := ("Y", "x", 2));
+      collect stats (expression);
+      ASSERT (num constants = 1 AND num vars = 2 AND num operators = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/ln-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL r = 1.0;
+      LONG REAL rr = LONG 2.0;
+      LONG LONG REAL rrr = LONG LONG 60.0;
+      ASSERT (ln (r) = 0.0);
+      long ln (rr);
+      long long ln (rrr)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/log-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL r = 1.0;
+      LONG REAL rr = LONG 2.0;
+      LONG LONG REAL rrr = LONG LONG 60.0;
+      ASSERT (log (r) = 0.0);
+      long log (rr);
+      long long log (rrr)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 0;
+      DO i +:= 1; IF i = 5 THEN exit FI
+      OD;
+exit: ASSERT (i = 5)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-10.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 0, n := 2;
+      FOR a FROM n BY 2 TO n + 2 DO i +:= a OD;
+      ASSERT (i = 2 + 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-11.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Negative steps towards minus infinity.  #
+BEGIN INT i := 0, n := -5;
+      BY -1 TO n - 1 DO i -:= 1 OD;
+      ASSERT (i = -8)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-12.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 0, n := 5;
+      FOR a TO n WHILE a < 3 DO i +:= 1 OD;
+      ASSERT (i = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-13.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 0;
+      FOR a FROM 2 BY 1 WHILE a <= 10
+      DO i +:= 1 OD;
+      ASSERT (i = 9)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-14.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# The while-part shall not be elaborated if the iterator is exhausted.  #
+BEGIN STRING s = "abc", INT j := 0;
+      FOR i TO UPB s WHILE s[i] /= "x"
+      DO j +:= 1 OD;
+      ASSERT (j = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-2.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# While loop.  #
+BEGIN INT i := 0;
+      WHILE INT j = 5; i < j
+      DO i +:= 1 OD;
+      ASSERT (i = 5)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-3.a68
@@ -0,0 +1,14 @@
+# { dg-options "-fstropping=upper" }  #
+# Nested loops.  #
+BEGIN INT i := 10, res := 0;
+      WHILE i > 0
+      DO INT j := 10;
+         WHILE j > 0
+         DO res +:= 1;
+            j -:= 1
+         OD;
+         ASSERT (j = 0);
+         i -:= 1;
+      OD;
+      ASSERT (i = 0 AND res = 100)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-4.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+# Nested loops and j on outside range.  #
+BEGIN INT i := 10, j := 10, res := 0;
+      WHILE i > 0
+      DO j := 10;
+         WHILE j > 0
+         DO res +:= 1;
+            j -:= 1
+         OD;
+         i -:= 1
+      OD;
+      ASSERT (i = 0 AND j = 0 AND res = 100)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-5.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# Skip in loop.  #
+BEGIN INT i := 0;
+      WHILE i +:= 1; i < 10
+      DO SKIP OD;
+      ASSERT (i = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-6.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# The range of the while-part shall cover the do-part.  #
+BEGIN INT i := 0;
+      WHILE INT incr = 2; i < 10
+      DO i +:= incr OD;
+      ASSERT (i = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-7.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 0, n := 5;
+      TO n + 1 DO i +:= 1 OD;
+      ASSERT (i = 6)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-8.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 0, n := 2;
+      FOR a TO n + 1 DO i +:= a OD;
+      ASSERT (i = 1 + 2 + 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-9.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 0, n := 2;
+      FOR a FROM n TO n + 2 DO i +:= a OD;
+      ASSERT (i = 2 + 3 + 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/loop-overflow-underflow.a68
@@ -0,0 +1,55 @@
+{ Test for overflow/underflow in loops with implicit and explicit
+  iterators. }
+
+begin int count;
+
+      { Overflow.  }
+      count := 0;
+      by 1 while true do count +:= 1 od;
+      assert (count = max_int);
+
+      count := 0;
+      from max_int do count +:= 1 od;
+      assert (count = 1);
+      count := 0;
+
+      by max_int do count +:= 1 od;
+      assert (count = 1);
+
+      count := 0;
+      for i by max_int do count +:= 1 od;
+      assert (count = 1);
+
+      count := 0;
+      by max_int % 2 do count +:= 1 od;
+      assert (count = 3);
+
+      count := 0;
+      by max_int - 1 do count +:= 1 od;
+      assert (count = 2);
+
+      { Underflow.  }
+      count := 0;
+      by -1 while true do count +:= 1 od;
+      assert (count = -min_int + 2);
+
+      count := 0;
+      from min_int by -1 do count +:= 1 od;
+      assert (count = 1);
+      count := 0;
+
+      by min_int do count +:= 1 od;
+      assert (count = 2);
+
+      count := 0;
+      for i by min_int do count +:= 1 od;
+      assert (count = 2);
+
+      count := 0;
+      by min_int % 2 do count +:= 1 od;
+      assert (count = 3);
+
+      count := 0;
+      by min_int + 1 do count +:= 1 od;
+      assert (count = 2)
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/lt-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 12;
+      LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12;
+      SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12;
+      ASSERT (i < 13);
+      ASSERT (ii LT LONG 13);
+      ASSERT (iii < LONG LONG 13);
+      ASSERT (s < SHORT 13);
+      ASSERT (ss < SHORT SHORT 13)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/lt-string-stride-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]CHAR matrix = (("1", "Z", "1"),
+                        ("4", "Y", "4"),
+                        ("7", "X", "9"));
+      ASSERT (matrix[1:3,1] < matrix[1:3,3]);
+      ASSERT (("1","4","0") < matrix[1:3,3])
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/lwb-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (LWB "foo" = 1);
+      ASSERT (LWB "" = 1);
+      ASSERT (1 LWB "foo" = 1);
+      ASSERT (1 LWB "" = 1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/execute.exp
@@ -0,0 +1,29 @@
+# Copyright (C) 2024 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/>.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+load_lib algol68-torture.exp
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.a68]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+    algol68-torture-execute $testcase
+}
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-1.3a.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL e = 2.7182818284; REAL circum;
+      circum := 2 * pi * e
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-1.3c.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n := 10, result;
+      result := n * (n + 1) * (2 * n + 1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.1a.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+# Integer denotations.  #
+BEGIN 000; 43; 456; 0
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.2a.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Real denotations.  #
+BEGIN .5; 0.5; 2.0; .001;
+      2.3e1; 2e0; 2e+0; 2e-0
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.3a.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+# Character denotations.  #
+BEGIN "X"; "a"; "1"; "."; " "
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3a.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Identifiers.  #
+BEGIN INT circum, r, ibm, a1, log2, begin;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3b.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Identity declarations.  #
+BEGIN REAL e = 2.7182818284, log2 = 0.618, INT ten = 10, g = 32;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3c.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Equivalent declarations.  #
+BEGIN REAL x = 2.34;
+      REF INT n = LOC INT, REF INT m = LOC INT;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3e.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Initialisation.  #
+BEGIN CHAR firstchar := "A", lastchar := "Z", currentchar;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2a.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Ordinary division.  #
+BEGIN ASSERT (4/2 = 2.0);
+      INT a = 4, b = 7;
+      a/b # Yields a value of mode REAL.  #
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2b.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+# Integer division.  The operator OVER (%) performs integer
+  division with truncation.  #
+BEGIN ASSERT (4 % 2 = 2);
+      ASSERT (4 OVER 2 = 2);
+      ASSERT (5 % 3 = 1);
+      ASSERT (5 OVER 3 = 1);
+      INT n = -5, m = -3;
+      ASSERT (n % 3 = -1);
+      ASSERT (n % m = 1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2c.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+# Integer modulus.  The operator MOD (%*) performs integer modulus
+  with truncation.  #
+BEGIN ASSERT (0 MOD 4 = 0);
+      ASSERT (0 %* 4 = 0);
+      ASSERT (5 %* 3 = 2);
+      INT m = 5, n = -3;
+      ASSERT (m MOD n = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.3a.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+# Exponentiation.  #
+BEGIN ASSERT (2 ** 3 = 8)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.6a.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Comparison operators.  #
+BEGIN REAL x = 2.7, y = 3.6, z = 4.7;
+      ASSERT (x < y);
+      ASSERT ("B" /= "C")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.6b.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Comparison operators and boolean operators.  #
+BEGIN INT a = 4, b = 5, c = 9, REAL x = 4.7, y = 5.7, z = 6.7;
+      ASSERT (NOT (x + y < z) AND a + b = c)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.7d.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Widening.  #
+BEGIN REAL x := 4, y := 7, z := 2.7;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.7e.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Dereferencing and widening.  #
+BEGIN INT n, REAL x = n;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.8a.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Examples of assignations.  #
+BEGIN REAL pi = 3.14, e = 2.71, INT n = 10, REAL circum, INT result;
+      circum := 2 * pi * e;
+      result := n * (n + 1) * ( 2 * n + 1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.8b.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Coercions and assignations.  #
+BEGIN REAL y, INT n, m := 1;
+      y := n % m
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-2.9.1a.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Arithmetical assignment operators.  #
+BEGIN INT m, n := 4;
+      n PLUSAB 1;
+      ASSERT (n = 5)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-3.5.1a.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+# Equivalence.  #
+BEGIN INT m := 3; REF INT p = m;
+      ASSERT (m = 3 AND p = 3);
+      BEGIN INT m := 100;
+            ASSERT (m = 100 AND p = 3);
+            m -:= 1; p +:= 1
+      END;
+      ASSERT (m = 4 AND p = 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-3.5d.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+# On the availability and accessibility of space.  #
+BEGIN INT m := 3, INT five = 5;
+      ASSERT (m = 3);
+      BEGIN INT m := 100; CHAR five = "5";
+            m +:= 1
+      END;
+      ASSERT (m = 3 AND five = 5)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-3.7.2a.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT p := 10, q := 12;
+      FROM p TO q DO (p +:= 1, q +:= 1) OD;
+      ASSERT (p = 13 AND q = 15)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-3.8.2a.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+# Using case clauses.  #
+BEGIN PROC is divisible = (INT m) BOOL:
+      BEGIN BOOL divisible := FALSE;
+            FOR i TO 4 WHILE NOT divisible
+            DO INT k = (i|3, 5, 7, 11);
+               divisible := m MOD k = 0
+            OD;
+            divisible
+      END;
+      ASSERT (is divisible (50));
+      ASSERT (is divisible (253))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-3.9.1b.a68
@@ -0,0 +1,16 @@
+# { dg-options "-fstropping=upper" }  #
+# Using jumps.  #
+BEGIN INT a, INT b = 0, c = 2, d = 10, BOOL e = TRUE;
+      CO The following program using jumps is equivalent to:
+         FOR a FROM b BY c TO d WHILE e DO SKIP OD
+      CO
+      BEGIN INT j := b, INT k = c, m = d;
+      next: IF (k > 0 AND j <= m) OR (k < 0 AND j >= m) OR k = 0
+            THEN INT i = j;
+                 IF e
+                 THEN SKIP; j +:= k; GOTO next
+                 FI
+            FI;
+            ASSERT (j = 12)
+      END
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.2a.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# Monadic lwb and upb.  #
+BEGIN INT n := 4; [n]INT a;
+      ASSERT (UPB a = 4);
+      n := 6;
+      ASSERT (UPB a = 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.3a.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+# Dyadic lwb an upb.  #
+BEGIN [0:10,-4:100]REAL xx;
+      ASSERT (1 LWB xx = 0);
+      ASSERT (1 UPB xx = 10);
+      ASSERT (1 UPB xx = UPB xx);
+      ASSERT (2 LWB xx = -4);
+      ASSERT (2 UPB xx = 100)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6a.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [4]REAL x2 := (6, 7, 8, 9);
+      ASSERT (x2[2] > 6.9);
+      ASSERT (x2[2] < 7.1);
+      x2 := (1, 1, 1, 1);
+      ASSERT(x2[2] > 0.9);
+      ASSERT(x2[2] < 1.1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6b.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# Multi-dimensional row displays.  #
+BEGIN [2,3]INT aa := ((1,2,3),(4,5,6));
+      [2,3,4]REAL bb := (((1,2,3,4), (5,6,7,8), (9,10,11,12)),
+                         ((13,14,15,16),(17,18,19,20),(21,22,2,24)));
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6c.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# Further row displays.  #
+BEGIN [4]INT a, b;
+      [4]INT c := a, d := (1,2,3,0);
+      [2,4]INT ab := (a,b), cd := ((0,0,0,0), b);
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6a.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRUCT (INT day, month, year) indep day = (4, 7, 1776);
+      ASSERT (day OF indep day = 4);
+      ASSERT (month OF indep day = 7);
+      ASSERT (year OF indep day = 1776);
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6b.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []STRUCT(CHAR letter, INT integer) roman
+        = (("I",1),("V",5),("X",10),("L",50),("C",100));
+      # XXX letter OF roman should be ("I","V","X","L","C")  #
+      # XXX integer OF roman whould be (1,5,10,50,100)  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6d.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+# Multiple values and structures.
+
+  Having strings of different lenghts would not be valid in a variable
+  declaration, but is acceptable in an identity declaration.
+#
+BEGIN []STRUCT ([]CHAR name, INT age) family =
+         (("JOHN", 3), ("ROBERT", 1), ("CATHERINE", 4));
+      SKIP
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.1a.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# Simple mode declarations.  #
+BEGIN MODE INTEGER = INT;
+      MODE Z = INT, R = REAL, B = BOOL, V = VOID;
+      MODE ARRAYA = [100]INT, ARRAYB = [10,2:9]REAL;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.1b.a68
@@ -0,0 +1,15 @@
+# { dg-options "-fstropping=upper" }  #
+# Dynamic arrays revisited.  #
+BEGIN INT p := 2, q := 10;
+      MODE M = [p:q]INT;
+      M a;
+      ASSERT (LWB a = 2 AND UPB a = 10);
+      q := 4;
+      M b;
+      ASSERT (LWB a = 2 AND UPB a = 10);
+      ASSERT (LWB b = 2 AND UPB b = 4);
+      M c = (1,2,3,4); # M is interpreted as formal declarer.
+                         Bounds are ignored.
+                       #
+      ASSERT (LWB c = 1 AND UPB c = 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.2a.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Rows of integers.  #
+BEGIN [][]INT g = ((1,2,3),(4,5),(6,7,8,9));
+      ASSERT (UPB g[1] = 3 AND UPB g[2] = 2 AND UPB g[3] = 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.2a.a68
@@ -0,0 +1,15 @@
+# { dg-options "-fstropping=upper" }  #
+# Procedure declarations I.  #
+BEGIN INT x = 10, y = 20, i = 2;
+      PROC xxx = (INT arg) INT: 10;
+      PROC yyy = (INT arg) INT: 20;
+      PROC zzz = (INT arg) INT: 30;
+      PROC(INT)INT f = IF x > y THEN xxx ELSE zzz FI,
+                   g = CASE i IN xxx, yyy, zzz ESAC;
+      PROC(INT)INT h := IF x < y THEN xxx ELSE yyy FI;
+      ASSERT (f (100) = 30);
+      ASSERT (g (200) = 20);
+      ASSERT (h (300) = 10);
+      h := yyy;
+      ASSERT (h (300) = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.3a.a68
@@ -0,0 +1,12 @@
+# { dg-options "-fstropping=upper" }  #
+# Using the factorial function in a program #
+BEGIN PROC f = (INT n) INT:
+      BEGIN INT product := 1;
+            FOR i TO n DO product *:= i OD;
+            product
+      END;
+      ASSERT (f(0) = 1);
+      ASSERT (f(1) = 1);
+      ASSERT (f(2) = 2);
+      ASSERT (f(3) = 6)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.3c.a68
@@ -0,0 +1,29 @@
+# { dg-options "-fstropping=upper" }  #
+# Procedure declarations III  #
+BEGIN # From the ALGOL68 Revised Report.  #
+      PROC my char in string = (CHAR c, REF INT i, []CHAR s) BOOL:
+      BEGIN BOOL found := FALSE;
+            FOR k FROM LWB s TO UPB s WHILE NOT found
+            DO (c = s[k] | i := k; found := TRUE) OD;
+            found
+      END;
+      ASSERT ((INT idx := 0;
+               my char in string ("o", idx, "foo")
+               ANDTH idx = 2));
+      ASSERT (my char in string ("x", LOC INT, "foo") = FALSE);
+      # Swapping function.  #
+      PROC swap = (REF INT a, b) VOID:
+         (INT r = a; a := b; b := r);
+      ASSERT ((INT x := 1, y := 2;
+               swap (x, y);
+               x = 2 AND y = 1));
+      # Euclid's algorithm.  #
+      PROC hcf = (INT m, n) INT:
+      BEGIN INT a := m, b := n;
+            IF a < b THEN swap (a, b) FI;
+            WHILE b /= 0
+            DO INT c = b; b := a MOD b; a := c OD;
+            a
+      END;
+      ASSERT (hcf (10, 20) = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.5a.a68
@@ -0,0 +1,19 @@
+# { dg-options "-fstropping=upper" }  #
+# Recursive procedures.  #
+BEGIN PROC f = (INT m, n) INT:
+         IF n = 0
+         THEN m
+         ELIF m < n
+         THEN f (n, m)
+         ELSE m * f (m % n, n - 1) + n * f (m - 1, n)
+         FI;
+      f (10, 20);
+      PROC a = (INT m, n) INT:
+         IF m = 0
+         THEN  + 1
+         ELIF n = 0
+         THEN a (m - 1, 1)
+         ELSE a (m - 1, a (m, n - 1))
+         FI;
+      a (10, 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2a.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Using AND and OR  #
+BEGIN ASSERT ((2r111 AND 2r101) = 2r101);
+      ASSERT ((16rff AND 2r111) = 16r7)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2b.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Comparing objects of mode BITS  #
+BEGIN ASSERT (2r1010 <= 2r1110);
+      ASSERT (4r331 >= 8r74);
+      ASSERT (NOT (2r100 >= 2r011))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2c.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Using BIN  #
+BEGIN ASSERT (BIN 7 = 2r111);
+      INT i = 22;
+      ASSERT ((BITS b = BIN i; ABS (b SHL 3) + ABS (b SHL 1)) = 220)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.1a.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# Declarations of flexible names.  #
+BEGIN FLEX[1:0]INT n;
+      ASSERT (LWB n = 1 AND UPB n = 0 AND ELEMS n = 0);
+      FLEX[4,6]INT p;
+      ASSERT (1 LWB p = 1 AND 1 UPB p = 4 AND 1 ELEMS p = 4
+              AND 2 LWB p = 1 AND 2 UPB p = 6 AND 2 ELEMS p = 6)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.1b.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+# Null row displays an string denotations.  #
+BEGIN FLEX[4]INT a, FLEX[4,6]INT b, FLEX[10]CHAR c;
+      a := ();
+      ASSERT (LWB a = 1 AND UPB a = 0);
+      b := ((),());
+      ASSERT (1 LWB b = 1 AND 1 UPB b = 2
+              AND 2 LWB b = 1 AND 2 UPB b = 0);
+      c := ();
+      c := ""
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.3a.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# Transient references and declarations.  #
+BEGIN FLEX[4,6]INT p;
+      []INT q1 = p[3,]; # Transient name is dereferenced giving []INT  #
+      REF FLEX[,]INT q5 = p; # p and q5 are different ways of accessing
+                               the same name.  #
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.2a.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+# Virtual declarers.  #
+BEGIN REF[]INT s;
+      STRUCT ([10]INT a, [4]REF[]INT b) c;
+      UNION (REF FLEX[]INT, PROC(INT)INT) f;
+      FLEX[4][3]INT a;
+      REF FLEX[][]INT aa = LOC FLEX[4][3]INT;
+      [4]FLEX[3]INT b;
+      REF[]FLEX[]INT bb = LOC[4]FLEX[3]INT;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.6a.a68
@@ -0,0 +1,23 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n := 3, m := 3;
+      REF INT w := n, z := n, REF INT y = n;
+      # Delivers TRUE since y and n deliver the same variable of mode REF
+        INT.  No coercions take place.
+      #
+      ASSERT (y :=: n);
+      # Delivers TRUE.  here w is dereferenced to yield n.  The right
+        hand side is taken to be strong since dereferencing cannot
+        occur in a soft position.
+      #
+      ASSERT (n :=: w);
+      # Similarly delivers TRUE.  Strong position is lhs.  #
+      ASSERT (w :=: n);
+      # Delivers TRUE.  No coercions take place.  #
+      ASSERT (y ISNT m);
+      # Delivers true.  w gets coerced to REF INT due to the strong
+        context introduced by the cast.  No further coercions take place.
+      #
+      ASSERT (REF INT (w) :=: z);
+      # Delives true.  No coercions take place.  #
+      ASSERT (w :/=: z)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.6b.a68
@@ -0,0 +1,12 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN
+   [3]INT a := (1,2,3);
+
+   CO Comparing transient or flex names using an identity relation is
+      undefined.  Therefore, a[2:3] :=: a[2:3] is undefined.
+   CO
+
+   # But the following are defined.  #
+   ASSERT (a[1] :=: a[1]);
+   ASSERT (a[1] :/=: a[2])
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcgt/mcgt-7.5.3a.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# Declarations involving global generators.  #
+BEGIN REF REAL xx;
+      BEGIN REF REAL x = HEAP REAL := 4;
+            xx := x
+      END;
+      ASSERT (xx = 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/clau02.a68
@@ -0,0 +1,23 @@
+{ Case conformity.  }
+begin mode M = union ([]int, bool, string);
+      proc prpm = ref proc M: heap proc M := M: "aap ";
+
+      int control := 0;
+      for n to 4
+      do case case n
+              in true,
+                 if false then "aa" else "b " fi,
+                 prpm { Gets deprocedured twice to yield a string.  }
+              out loc[1:1]int := 1 { Gets dereferenced then copied.  }
+              esac
+         in (union(string, bool) sb):
+               (control +:= 1;
+                (sb | (bool b): assert (b), (string s): assert (s = "b " OR s = "aap "))),
+            ([]int i):
+               (control +:= 1;
+                assert (i[1] = 1))
+         out assert (false)
+         esac
+      od;
+      assert (control = 4)
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/clau04.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+# Vacuum.  #
+BEGIN ASSERT (LWB []INT BEGIN END = 1);
+      ASSERT (UPB []INT() = 0);
+      CO XXX trimmer ASSERT (UPB([]INT())[1:0] = 0); CO
+      ASSERT (2UPB[,]INT([]INT(puts("here");())) = 0);
+      ASSERT (1UPB[,]INT([]INT(puts("there");())) = 1);
+      ASSERT (2UPB[,]INT(()) = 0);
+      CO runtime error: wrong length CO
+      CO 2UPB[,]INT((),(1)) CO
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/clau05.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+# Test vaccum as string.  #
+BEGIN PROC p = (STRING s) VOID:
+      BEGIN ASSERT (LWB s = 1);
+            ASSERT (UPB s = 0)
+      END;
+
+      p ("");
+      p (());
+      p (BEGIN END)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/clau07.a68
@@ -0,0 +1,21 @@
+# { dg-options "-fstropping=upper" }  #
+# If-, case- and ucase-clauses.  #
+BEGIN FOR i
+      DO (i = 1 | 1 |: i = 2 | 2 |: i = 3 | 3 | eo if) OD;
+eo if:
+
+      FOR i
+      DO (i | 4, 5 |: i - 2 | 6, 7 | eo case) OD;
+eo case:
+
+      FOR i
+      DO ( (UNION (INT,REAL,CHAR,STRING,BOOL)
+            (i | 1, 1.0, "a", "", TRUE)
+           | (INT): 8, (REAL): 9
+           |: UNION (CHAR,STRING,BOOL) (i - 2 | "a", "", TRUE)
+           | (CHAR): 10, (STRING): 11
+           | eo ucase) )
+      OD;
+eo ucase:
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/clau08.a68
@@ -0,0 +1,159 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN  stop;   # no errors, but loops if not stopped here #
+
+# A:  Statements in the context of a BEGIN block #
+
+BEGIN  label : SKIP;
+        l1:BEGIN SKIP; SKIP END;
+
+        BEGIN GOTO label; GO TO label END;
+
+        BEGIN INT a1, a2, a3;
+        l4:FOR i FROM a1BY a2TO a3 DO SKIP OD;
+        FOR i FROM a1BY a2TO a3 DO SKIP OD
+        END;
+
+        l2:BEGIN BOOL a;
+            IF a THEN SKIP FI;
+            l5:IF a THEN SKIP FI
+        END;
+
+        BEGIN PROC VOID a; l6: a; a END;
+
+        l3 : BEGIN PROC (INT) VOID a; INT b;
+            a(b); l7 : a(b)
+        END;
+
+        BEGIN REAL a; a:= a; a:= a END;
+
+        BEGIN REF[]REAL a; INT i;
+            l8 : a[i]:=i; a[i]:=i
+        END;
+
+        BEGIN BEGIN SKIP END;
+            BEGIN SKIP END
+        END
+END;
+
+# B:  Statements in the context of a ( block #
+
+(  label : SKIP;
+        l1:( SKIP; SKIP );
+
+        ( GOTO label; GO TO label );
+
+        ( INT a1, a2, a3;
+        l4:FOR i FROM a1BY a2TO a3 DO SKIP OD;
+        FOR i FROM a1BY a2TO a3 DO SKIP OD
+        );
+
+        l2:( BOOL a;
+            IF a THEN SKIP FI;
+            l5:IF a THEN SKIP FI
+        );
+
+        ( PROC VOID a; l6: a; a );
+
+        l3 : ( PROC (INT) VOID a; INT b;
+            a(b); l7 : a(b)
+        );
+
+        ( REAL a; a:= a; a:= a );
+
+        ( REF[]REAL a; INT i;
+            l8 : a[i]:=i; a[i]:=i
+        );
+
+        ( ( SKIP );
+            ( SKIP )
+        )
+);
+
+# C:  Statements in the context of IF statement #
+
+BEGIN BOOL true;
+
+    IF true THEN SKIP; SKIP FI;
+
+    IF true THEN SKIP ELSE SKIP; SKIP FI;
+
+    IF true THEN IF true THEN SKIP FI
+            FI;
+
+    IF true THEN IF true THEN SKIP FI
+            ELSE SKIP FI;
+
+    IF true THEN IF true THEN SKIP ELSE SKIP FI
+            FI;
+
+    IF true THEN IF true THEN SKIP ELSE SKIP FI
+            ELSE SKIP FI;
+
+    IF true THEN SKIP
+            ELSE IF true THEN SKIP FI
+            FI;
+
+    IF true THEN SKIP
+            ELSE IF true THEN SKIP ELSE SKIP FI;
+                IF true THEN SKIP FI; SKIP
+            FI
+
+END;
+
+# D:  Statements in the context of a FOR statement #
+
+BEGIN INT a1, a2, a3; BOOL true;
+        PROC VOID proc1; PROC (INT) VOID proc2;
+        REAL aa; REF[]REAL bb;
+
+    FOR i FROM a1 BY a2 TO a3
+            DO SKIP; SKIP OD;
+
+    FOR i FROM a1 BY a2 TO a3
+            DO GOTO stop; GOTO stop OD;
+
+    FOR i FROM a1 BY a2 TO a3
+            DO IF true THEN SKIP FI;
+            IF true THEN SKIP FI OD;
+
+    FOR i FROM a1 BY a2 TO a3
+        DO FOR i FROM a1 BY a2 TO a3
+                DO SKIP OD;
+            FOR i FROM a1 BY a2 TO a3
+                DO SKIP OD OD;
+
+    FOR i FROM a1 BY a2 TO a3
+            DO proc1; proc1 OD;
+
+    FOR i FROM a1 BY a2 TO a3
+            DO proc2(a1); proc2(a1) OD;
+
+    FOR i FROM a1 BY a2 TO a3
+            DO aa := aa; aa := aa OD;
+
+    FOR i FROM a1 BY a2 TO a3
+            DO bb [i] := a1; bb[i] := a1 OD;
+
+    FOR i FROM a1 BY a2 TO a3
+            DO BEGIN SKIP END;
+                BEGIN SKIP END OD
+
+END;
+
+# E:  Statements in the context of a routine declaration #
+
+BEGIN BOOL true; INT a1, a2, a3;
+        REF[]INT a4 = a1; REAL a5;
+    PROC a = VOID:SKIP;
+    PROC b = VOID: IF TRUE THEN SKIP FI;
+    PROC c = VOID: FOR i FROM a1 BY a2 TO a3 DO SKIP
+                OD;
+    PROC d = VOID: d;
+    PROC (INT) VOID e = (INT f) VOID: e(f);
+    PROC f = VOID: a5:=a5;
+    PROC g = VOID: a4[a1] := a1;
+    PROC h = VOID: BEGIN SKIP END;
+
+    SKIP
+END
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/clau09.a68
@@ -0,0 +1,82 @@
+# { dg-options "-fstropping=upper" }  #
+# Optimisation correct?  #
+BEGIN
+      PROC itoa = (INT i) STRING:
+      BEGIN IF i = 0
+            THEN "0"
+            ELSE INT n := i;
+                 STRING res := (i < 0 | n := -n; "-");
+                 WHILE n /= 0
+                 DO INT rem = n %* 10;
+                    res +:= REPR (rem > 9 | (rem - 10) + ABS "a" | rem + ABS "0");
+                    n %:= 10
+                 OD;
+                 res
+            FI
+      END;
+   
+    puts("\nPrints errors only\n");
+
+    PROC puti = (INT i, INT p, q) VOID:
+    IF p /= q THEN puts (itoa (i) + "," + itoa (p) + "," + itoa (q)) FI;
+
+    PROC putr = (INT i, REAL p, q) VOID:
+    IF p /= q THEN puts (itoa (i) + ", p /= q") FI;
+
+BEGIN
+    [1:3]INT a;
+    a[1]:=2; a[2]:=3; a[3]:=1;
+    putr(1, 44.9104,
+        (-1.0+(-2.0+(-3.0+(-4.0+2))))
+        +(
+        (-5.0+(-2.0-(-5.0+(-2.0-7))))
+        -(
+        a[a[a[a[a[2]]]]]
+        +(
+        a[a[a[a[a[1]]]]]
+        -(
+        a[a[a[a[a[3]]]]]
+        + (
+        (-1.0*(-2.0*(-3.0*(-4.0*2))))
+        -  (
+        (-5.0*(-2.0*(-5.0*(-2.0*7))))
+        *     (
+    128*(-1.0/(-2.0/(-4.0/(-4.0/2))))
+        /    (
+        (-10.0/(-5.0/(-5.0/(-2.0/2))))
+        **
+        a[a[a[a[a[2]]]]]
+        **
+        a[a[a[a[a[1]]]]]
+        **
+        a[a[a[a[a[3]]]]]
+        ))))))))
+    )
+END;
+
+BEGIN REAL x; [1:20]REAL a;
+    FOR i FROM 1 BY 1 TO 20
+    DO a[i] := i-10 OD;
+    x := a[1]+(a[2]+(a[3]+(a[4]+(a[5]+(a[6]+(a[7]+(a[8]+(a[9]+
+        (a[10]+(a[11]+(a[12]+(a[13]+(a[14]+(a[15]+(a[16]+
+        (a[17]+(a[18]+(a[19]+(a[20])))))))))))))))))))-9.0;
+    putr(2, 1.0, x)
+END;
+
+BEGIN
+
+    [1:10]INT a;
+
+    FOR i FROM 1 BY 1 TO 9 DO a[i]:=i+1 OD;
+    a[10]:=1;
+
+    FOR i FROM 1 BY 1 TO 10
+    DO puti(3, i, a[a[a[a[a[a[a[a[a[a[a[a[a[a[a[a[a[a[a[a[i
+            ]]]]]]]]]]]]]]]]]]]]
+        )
+    OD
+END;
+
+    puts ("\nEnd of tests\n");
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/coer01.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT ((REAL x := 0; REF[]REAL (x) := 1; x) = 1.0);
+      ASSERT ((INT n := 0; n +:= 1 := 5) = 5)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/coer02.a68
@@ -0,0 +1,20 @@
+# { dg-options "-fstropping=upper" }  #
+# Widening #
+BEGIN
+  FOR i TO 2 DO
+  ASSERT (
+    CASE i IN TRUE,     2r1    OUT []BOOL(TRUE) ESAC
+   [CASE i IN  1  , bits width OUT     SKIP     ESAC]
+    ) OD;                                    # TT #
+
+  INT n := 1;
+  ASSERT ((re OF CASE n IN 1, 2.0, 3 I 5 ESAC) = 1.0);
+  ASSERT ((im OF CASE n IN 1, 2.0, 3 I 5 ESAC) = 0.0);
+  n := 2;
+  ASSERT ((re OF CASE n IN 1, 2.0, 3 I 5 ESAC) = 2.0);
+  ASSERT ((im OF CASE n IN 1, 2.0, 3 I 5 ESAC) = 0.0);
+  n := 3;
+  ASSERT ((re OF CASE n IN 1, 2.0, 3 I 5 ESAC) = 3.0);
+  ASSERT ((im OF CASE n IN 1, 2.0, 3 I 5 ESAC) = 5.0)
+                                       # 1.0 0.0, 2.0 0.0, 3.0 5.0 #
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/coer03.a68
@@ -0,0 +1,53 @@
+# { dg-options "-fstropping=upper" }  #
+# Morf versus comorf.  #
+BEGIN BOOL canary := FALSE;
+      PROC right = VOID: canary := TRUE,
+           wrong = VOID: (ASSERT (FALSE)),
+           check = VOID: (ASSERT (canary); canary := FALSE);
+
+      PROC deproc = (STRING mcm) VOID:
+         (puts (mcm); puts ("deproc:"));
+      PROC nodeproc = (STRING mcm) VOID:
+         (puts (mcm); puts ("nodeproc:"));
+
+      deproc ("selection");
+      proc OF STRUCT(PROC VOID proc, INT d)(right, SKIP);
+      check;
+
+      deproc ("slice");
+      []PROC VOID(right)[1];
+      check;
+
+      deproc ("routine text");
+      PROC VOID: right;
+      check;
+
+      deproc ("formula");
+      OP + = (INT i) PROC VOID: right; +1;
+      check;
+
+      deproc ("call");
+      ((INT i) PROC VOID: right)(1);
+      check;
+
+      deproc ("identifier");
+      right;
+      check;
+
+      nodeproc ("assignation");
+      LOC PROC VOID := wrong;
+
+      nodeproc ("cast");
+      PROC VOID (wrong);
+
+      nodeproc ("generator");
+      LOC PROC VOID;
+
+      FOR i TO 2
+      DO IF i = 1
+         THEN deproc ("balance"); right
+         ELSE nodeproc ("balance"); PROC VOID(wrong)
+         FI;
+         IF i = 1 THEN check FI
+      OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/coer07.a68
@@ -0,0 +1,14 @@
+# { dg-options "-fstropping=upper" }  #
+# Weak balance.  #
+BEGIN COMPL c := (COMPL x:=1;
+                  CASE 2
+                  IN NIL,
+                     IF [] BOOL (TRUE, FALSE)[2]
+                     THEN REF REF [] COMPL: NIL
+                     ELSE x
+                     FI,
+                     LOC PROC REF [] STRUCT (REAL re,im)
+                  ESAC # REF [] COMPL = x # [1]:=3; x);
+      ASSERT (re OF c = 3.0);
+      ASSERT (im OF c = 0.0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/coer08.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+# Soft balance.  #
+BEGIN ASSERT ((HEAP INT x := 314;
+               CASE 3
+               IN SKIP,
+                  IF x < 0 THEN GOTO stop ELSE REF[]INT: NIL FI,
+                  IF x > 0 THEN x ELSE x +:= 1 FI
+               ESAC := 200)[1] = 200)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/coer09.a68
@@ -0,0 +1,16 @@
+# { dg-options "-fstropping=upper" }  #
+# Soft balance.  #
+BEGIN ASSERT (CASE 2
+              IN SKIP,
+                 NIL,
+                 IF BOOL (SKIP)
+                 THEN GOTO stop
+                 ELSE PROC REF[]INT (SKIP)
+                 FI
+              ESAC :=: CASE 3
+                       IN LOC REF REF []INT,
+                          LOC INT,
+                          NIL
+                       ESAC)
+      # TRUE, would you believe.  #
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/coer10.a68
@@ -0,0 +1,62 @@
+# { dg-options "-fstropping=upper" }  #
+# Union with VOID #
+BEGIN OP TOPROCINT = (INT i) PROC INT : INT : 1;
+      OP TOVOID = (INT i) VOID : 1;
+
+      STRING proc int = "proc int", void = "void",
+             before = "before ", after = " after",
+             newline = "\n";
+
+      puts ("Results must be:" + newline +
+            void + newline +
+            proc int + after + " 1 " + newline +
+            before +  void + newline +
+            before + void + newline +
+            before + void + newline +
+            proc int + " 1 " + newline +
+            void + newline +
+            proc int + " 1 " + newline +
+            proc int + after + " 1 " + newline +
+            before + void + newline + 
+            newline + "Results are:" + newline);
+
+      UNION(PROC INT, VOID) upiv := EMPTY;
+      PROC pupiv = VOID:
+         (upiv
+             |(PROC INT pi) : (puts (proc int + " pi " + newline))
+             | puts (void + newline));
+
+      pupiv;
+      upiv:= INT : (puts(after); 1);
+      pupiv;
+
+      upiv:= VOID : (puts(before); 1);
+      pupiv;
+
+      upiv:= VOID ((puts(before); 1));
+      pupiv;
+
+      # firm void position #
+      upiv:= puts(before);
+      pupiv;
+
+      upiv:= TOPROCINT 1;
+      pupiv;
+
+      upiv:= TOVOID 1;
+      pupiv;
+
+      upiv:= INT : 1;
+      upiv:= label # must jump before assigning #; puts("Error 1");
+label:
+      pupiv;
+
+      FOR i TO 2
+      DO upiv:=
+            CASE i IN
+               INT : (puts(after); 1),
+               VOID : (puts(before); 1)
+            ESAC;
+         pupiv
+      OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/coer11.a68
@@ -0,0 +1,37 @@
+# { dg-options "-fstropping=upper" }  #
+# Contains all possible two-member coercion sequences.  #
+BEGIN UNION(INT, BOOL) ib:= 1;
+
+      []REAL(1);
+      []REAL(INT : 1);
+      []REAL(REAL : 1);
+
+      [,]COMPL (1);
+      [] [,]COMPL (LOC INT:= 1);
+      [] [,]COMPL ([]COMPL(1, 2));
+
+      [,,] [] BOOL (16 r f);
+      [,,] [] [,] BOOL (16 r f);
+      [,,] [] BOOL (BITS : 16 r f);
+      [,,] [] [,] BOOL (BITS : 16 r f);
+
+COMMENT XXX bytes pack not supported yet
+      [,] [] CHAR (bytes pack ("ab"));
+      [,] [] [,] CHAR (bytes pack ("ab"));
+      [,] [] CHAR (LOC BYTES:= bytes pack("ab"));
+      [,] [] [,] CHAR(LOC BYTES:= bytes pack("ab"));
+COMMENT
+      
+      REF[]INT(REF INT : HEAP INT:= 1);
+      REF[,]INT(REF[]INT : HEAP[1]INT:= 1);
+
+      UNION(INT, REAL, BOOL) (ib);
+      [] REF [] [,] [] [] INT
+          (LOC PROC REF INT:= REF INT : HEAP INT:= 1) [1];
+
+      []UNION(INT, REAL) (LOC INT:= 1) [1];
+      []UNION(INT, REAL) (REAL : 1) [1];
+      []UNION(INT, REAL, BOOL) (ib) [1];
+
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/coer13.a68
@@ -0,0 +1,19 @@
+# { dg-options "-fstropping=upper" }  #
+# Soft balance with EXIT's.  #
+BEGIN INT i; [ 1 : 1 ]INT ri, rj;
+      PROC pri = REF[]INT : rj;
+
+      FOR c TO 3
+      DO
+         ([]PROC VOID switch = ( lrri, li, lpri);
+          switch[c]; SKIP                        # hip #
+         EXIT lrri: LOC REF[]INT := ri           # deref #
+         EXIT li: i                              # row #
+         EXIT lpri: pri                          # deproc #
+         ) := c
+      OD;
+
+      ASSERT (ri[1] = 1);
+      ASSERT (i = 2);
+      ASSERT (pri[1] = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/coer14.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+# Rowing of NIL yields NIL.  #
+BEGIN ASSERT (REF[]INT(NIL) :=: REF INT(NIL))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/decl01.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# Some declarers.  #
+BEGIN [1:10]INT i,
+      [1:10]STRUCT(REF[]INT i, BOOL j) k,
+      [1:10]STRUCT([1:10]INT i, BOOL j) l,
+      [1:10]REF[]INT p;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/decl03.a68
@@ -0,0 +1,40 @@
+# { dg-options "-fstropping=upper" }  #
+# P.G. Hibbard, Proc. Int. Conf. A68 III, Winnipeg, June 1974:
+  applied occurrence of mode-indication in actual-bounds
+  of its actual-declarer
+#
+BEGIN PROC itoa = (INT i) STRING:
+      BEGIN IF i = 0
+            THEN "0"
+            ELSE INT n := i;
+                 STRING res := (i < 0 | n := -n; "-");
+                 WHILE n /= 0
+                 DO INT rem = n %* 10;
+                    res +:= REPR (rem > 9 | (rem - 10) + ABS "a" | rem + ABS "0");
+                    n %:= 10
+                 OD;
+                 res
+            FI
+      END;
+
+      INT n := 4;
+      CHAR a := "a", b := "b", c := "c", d;
+
+      PROC swap = (REF CHAR c1, c2) VOID:
+         (d := c1; c1 := c2; c2 := d);
+
+      MODE HANOI =
+              [IF n > 0
+               THEN n -:= 1;
+                    swap (b, c);
+                    HANOI h1;
+                    swap (b, c);
+                    puts ("move " + itoa (LWB h1 + 1) + " from " + a + " to " + c);
+                    swap (a, b);
+                    HANOI h2;
+                    swap (a, b);
+                    n +:= 1
+               ELSE 0
+               FI : 1] INT;
+      LOC HANOI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/decl04.a68
@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper" }  #
+(MODE U = UNION(INT,REAL);
+ LOC UNION(U) # no list needed  # u := 1; SKIP)
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/decl05.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# Application of a virtually useless mode.  #
+BEGIN puts ("Result should be ppp");
+      MODE P = PROC (P) P;
+      P p = (P p) P: (puts ("p"); p);
+      (p(p(p(p))))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/execute.exp
@@ -0,0 +1,29 @@
+# Copyright (C) 2024 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/>.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+load_lib algol68-torture.exp
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.a68]] {
+    # If we're only testing specific files and this isn't one of them, skip it.
+    if ![runtest_file_p $runtests $testcase] then {
+	continue
+    }
+    algol68-torture-execute $testcase
+}
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/flex01.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE S = FLEX[1:0]CHAR, T = [1:0]CHAR;
+      REF STRING n = LOC STRING := "Next line will be empty, then a";
+      UNION (REF S, REF T) f = LOC T := "";
+      UNION (STRING, CHAR) u = UNION (S,CHAR) ("a");
+
+      puts (n);
+      puts ((f | (REF S s): s, (REF T t): t));
+      puts ((u | (STRING s): s, (CHAR c): c))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/flex02.a68
@@ -0,0 +1,11 @@
+{ Transiency tests.  }
+begin bool b = true, y = false;
+
+      assert ((if b then loc char else (loc string)[1] fi := "a")
+              = "a");
+      assert ((if b then loc[1:3]char else (loc string)[] fi := "bcd")
+              = "bcd");
+      { XXX original says loc string but parser doesn't like it.
+        probably parser bug }
+      if y then loc char else loc[1:1,1:3]char fi := "efg"
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/idef01.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN IF INT i := 1; FALSE
+      THEN INT i := 2; ASSERT (i = 2)
+      ELSE ASSERT (i = 1)
+      FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/idef02.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN IF INT i := 1; TRUE
+      THEN INT i := 2; ASSERT (i = 2)
+      ELSE ASSERT (i = 1)
+      FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/idef03.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 1;
+
+      PROC a = INT: (INT i = 2; b);
+      PROC b = INT: i;
+      ASSERT (a = 1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/idef04.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 1, j := -1;
+
+      PROC a = VOID: (INT i = 2, j = -2; b);
+      PROC b = VOID: (INT j = -3;
+                      PROC c = VOID: (ASSERT (i + j = -2));
+                      d (c));
+      PROC d = (PROC VOID e) VOID:
+         (INT i = 4, j = -4; e);
+      a
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/idef05.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 2;
+      (INT i = i; ASSERT (i = 0))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/idef06.a68
@@ -0,0 +1,23 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRING int = "INT", real = "REAL", rreal = "[]REAL";
+
+      OP AA = (UNION(INT,REAL,[]REAL) p) UNION(REAL,[]REAL):
+         CASE p
+         IN (INT i): AA REAL (i),
+            (REAL r): AA []REAL (r)
+         OUSE p
+         IN ([]REAL rr): CASE ROUND rr[1] IN 3.0, rr OUT 4.0 ESAC
+         OUT error
+         ESAC;
+
+      FOR i TO 3
+      DO AA AA CASE i
+               IN UNION(REAL,INT)(1),
+                  UNION(INT,[]REAL)([]REAL(2)),
+                  AA 3
+               ESAC
+      OD;
+      0 EXIT
+error:
+     puts ("Error in united-case clause");
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/idef07.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# Redeclaring LWB.  #
+BEGIN OP LWB = ([]INT a) REAL: a[1] + a[2];
+      OP LWB = ([]REAL a) REAL: a[1] - a[2];
+
+      ASSERT (LWB (1| (8, 2), 3, []INT: SKIP) = 10);
+      ASSERT (LWB (1| (8, 2), 3, []REAL: SKIP) = 6.0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/idef11.a68
@@ -0,0 +1,17 @@
+# { dg-options "-fstropping=upper" }  #
+# More operators and uniting.  #
+BEGIN MODE UN = UNION (INT, REAL);
+      OP + = (UNION (REF UN, REF CHAR) a) VOID:
+      BEGIN CASE a
+            IN (REF UN ru): (ru |
+                             (INT i): (puts ("integer"); SKIP),
+                             (REAL r): (puts ("real"); SKIP)
+                            ),
+               (REF CHAR ch): (puts ("char"); SKIP)
+            ESAC
+      END;
+
+      +(HEAP UN := 1);
+      +(HEAP UN := 2.0);
+      +(HEAP CHAR := "3")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/idef12.a68
@@ -0,0 +1,52 @@
+# { dg-options "-fstropping=upper" }  #
+# Priorities and weird constructions #
+BEGIN
+WHILE INT n:= 0;
+    OP + = (REF INT i, CHAR c) STRING: "ab";
+  ( WHILE DO GOTO skip OD; TRUE DO SKIP OD;
+    PRIO + = 1; SKIP
+    EXIT skid:
+        (HEAP INT +:= 1 + "1" +=: (HEAP STRING := "c")) = "abc"
+    EXIT skip: GOTO skid
+  )
+DO DO
+    # The implicit structure of the formulas is
+            ( a O1 ( b + ( c O2 d)))
+      which is only achieved if   pr(O1) < pr(+) < pr(O2)
+    #
+
+    PRIO + = 2;
+
+    OP + = (INT i, BOOL b) STRING: (puts("corr"); "ect,");
+    OP + = (REAL x, BOOL b) BOOL: (puts("Line "); FALSE);
+    OP + = (CHAR c, BOOL b) BOOL: (puts("two "); FALSE);
+    OP + = (BITS b, INT i) STRING: (puts("one "); "Nope ");
+    OP + = (REF BYTES b, REAL x) INT: (puts("is "); -(n+:=1));
+    OP + = (STRING s, COMPL c) BITS: (puts("sho"); drop);
+
+     puts((HEAP STRING +:=
+         ABS
+         IF PRIO + = 3;
+             ODD n OR 2.0 + "a" = "b"
+         THEN PRIO + = 4;
+             TRUE AND "a" + 2 < 3
+         ELSE PRIO + = 5;
+             "prio" = 2r1 + 2 - 3
+         FI
+
+         +              # prio 2 #
+
+         CASE PRIO + = 7;
+             0 - LOC BYTES + 3.0 ** 5
+         IN TRUE, FALSE
+         OUT PRIO + = 8;
+             3 ELEM "prio" + 2.0 I 3.0
+         ESAC
+
+         AND random < .5) + "\n")
+     OD
+     EXIT drop:
+         puts("rter than line three." + "\n" + "End of test");
+         stop
+OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/idrl01.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# Identity relations.  #
+BEGIN REAL x; REF REAL y := x;
+      ASSERT ((x :=: y) AND (y :=: x));
+      ASSERT (x :=: REF[]REAL(x)[1]);
+      ASSERT (x :/=: REF[]REAL(x))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/jump01.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+# Simple jumps and EXITs.  #
+BEGIN INT control := 0;
+      FOR i TO 2
+      DO IF i = 2 THEN GOTO l FI; control +:= 10 EXIT
+      l: control +:= 3
+      OD;
+      ASSERT (control = 13)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/jump02.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL a;
+      GOTO l;
+      INT i := 1;
+      # The declaration of `i' has not been elaborated.  #
+l:    ASSERT (i = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/jump03.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 1, j := 2;
+      i := j := (GOTO l; 3);
+l:    ASSERT (i = 1 AND j = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/jump04.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+# Jump out of procedure.  #
+BEGIN # Directly  #
+      (PROC jump = VOID: (GOTO l; ASSERT (FALSE));
+       jump; ASSERT (FALSE);
+       l: SKIP);
+      # Indirectly  #
+      (MODE HIDE = PROC VOID;
+       HIDE p = (TRUE | GOTO m);
+       p; ASSERT (FALSE); m: SKIP)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/mdeq02.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# Mode equivalencing.  #
+BEGIN MODE N = PROC(M)M, M = PROC(N)N;
+      # Both okay, since M and N are the same.  #
+      PROC M(PROC N(SKIP));
+      PROC N(PROC M(SKIP));
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/mdeq04.a68
@@ -0,0 +1,17 @@
+# { dg-options "-fstropping=upper" }  #
+# Unions.  #
+BEGIN MODE N = UNION (REAL, UNION (BOOL, INT)),
+           M = UNION (UNION (REAL, BOOL), INT);
+      # Both okay, since M and N are the same.  #
+      PROC M (PROC N (SKIP));
+      PROC N (PROC M (SKIP));
+
+      MODE U = UNION (INT, PROC(U)INT),
+           V = UNION (U, PROC(V)INT);
+      # Both okay, since U and V are the same.  #
+      PROC U (PROC V (SKIP));
+      PROC V (PROC U (SKIP));
+
+      SKIP
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/misc07.a68
@@ -0,0 +1,207 @@
+# { dg-options "-fstropping=upper" }  #
+# 100 nested proc declarations; prints 100 100 #
+(INT i := 0; INT j := (INT a =
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+(PROC a = INT:
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+i+:=1; a);
+a);
+ASSERT (i = j);
+ASSERT (i = 100 AND j = 100)
+)
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/null01.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# The original test uses just SKIP, but this compiler requires an
+  enclosed clause.  #
+
+(SKIP)
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/null02.a68
@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper" }  #
+(0)
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/null03.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN DO stop OD
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/null04.a68
@@ -0,0 +1,2 @@
+# { dg-options "-fstropping=upper" }  #
+((SKIP,SKIP))
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/null05.a68
@@ -0,0 +1,2 @@
+# { dg-options "-fstropping=upper" }  #
+(PAR (SKIP,SKIP))
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/null06.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN BY 0 DO stop OD
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/null07.a68
@@ -0,0 +1,2 @@
+# { dg-options "-fstropping=upper" }  #
+IF BOOL (SKIP) THEN SKIP FI
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/null08.a68
@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper" }  #
+CASE INT(SKIP) IN SKIP, SKIP ESAC
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/null09.a68
@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper" }  #
+CASE UNION(BOOL, VOID)(SKIP) IN (VOID): SKIP ESAC
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/numr07.a68
@@ -0,0 +1,81 @@
+# { dg-options "-fstropping=upper" }  #
+#JKok, 730612, test Choleski decomposition#
+BEGIN OP * = ([]REAL a, b) REAL :
+         (REAL s:= 0; FOR i TO UPB a DO s +:= a[i] * b[i] OD;s);
+
+      PROC decsym= (REF [,] REAL a, REF [] INT p, REAL aux)
+            INT :
+         IF INT n = 1 UPB a;
+            2 UPB a /= n OR UPB p /= n THEN 0
+         ELSE REAL max:= 0, epsnorm, ukk, uki, aii, INT pk:= 1, r:= 0;
+
+              PROC ichvec= (REF [] REAL a, b) VOID :
+                 IF INT n= UPB a; n > 0 THEN
+                    [] REAL h= a; a:= b; b:= h
+                 FI # interchange two vectors#;
+
+              FOR k TO n
+              DO IF a[k,k] > max THEN max:= a[k,k]; pk:= k FI OD;
+              epsnorm:= aux * max;
+              FOR k TO n WHILE max > epsnorm
+              DO INT k1 = k + 1;
+                 p[k]:= pk; r:= k;
+                 IF pk /= k
+                 THEN ichvec(a[ :k-1,k], a[ :k-1,pk]);
+                      ichvec(a[k,k1:pk - 1], a[k1:pk - 1,pk]);
+                      ichvec(a[k,pk + 1: ], a[pk,pk + 1: ]);
+                      a[pk,pk]:= a[k,k]
+                 FI;
+                 ukk:= a[k,k]:= sqrt(max); max:= 0; pk:= k1;
+                 FOR i FROM k1 TO n
+                 DO uki:= a[k,i]:= (a[k,i] - a[ :k-1,k]*a[ :k-1,i]) / ukk;
+                    aii:= a[i,i] -:= uki * uki;
+                    IF aii > max THEN max:= aii; pk:= i FI
+                 OD
+              OD;
+              r
+         FI # Choleski decomposition with diagonal pivoting#,
+
+      PROC solsym= ([,] REAL a,[] INT p,REF [] REAL b) VOID:
+         IF INT n = 1 UPB a;
+            2 UPBa = n AND UPB p = n AND UPB b = n
+         THEN INT pk, REAL r;
+              FOR k TO n
+              DO r:= b[k]; pk:= p[k];
+                 b[k]:= (b[pk] - a[ :k - 1,k] * b[ :k - 1]) / a[k,k];
+                 IF pk /= k THEN b[pk]:= r FI
+              OD;
+              FOR k FROM n BY - 1 TO 1
+              DO b[k]:= (b[k] - a[k,k+1: ] * b[k+1: ]) / a[k,k] OD;
+              FOR k FROM n BY - 1 TO 1
+              DO IF pk:= p[k]; pk /= k
+                 THEN r:= b[k]; b[k]:= b[pk]; b[pk]:= r FI
+              OD
+         FI # solution of Choleski decomposed system #;
+
+      puts ("Value,  expected,  difference\n\n");
+
+      FOR n TO 8
+      DO [1:n, 1:n] REAL a, aa, [1:n]REAL b, c, [1:n]INT piv;
+         FOR i TO n DO FOR j TO n
+                       DO a[i,j]:= aa[i,j]:= 1 / (2 * n + 1 - i - j) OD OD;
+         FOR i TO n DO b[i]:= 2 ** (n - i) OD;
+         IF decsym (a, piv, 1e-13) = n
+         THEN solsym(a, piv, b);
+              FOR i TO n
+              DO
+                 CO puts (aa[i,] * b, REAL(2 ** (n - i)),
+                    aa[i,] * b - 2 ** (n - i));
+                 CO
+                 puts ("term\n")
+              OD
+         ELSE puts ("Coefficients matrix is not positive definite")
+         FI;
+         puts ("\n")
+     OD
+    #Output approximately: 1
+                           2  1
+                           4  2  1
+                           . . .
+                           128   64   . . .   1 #
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/oper01.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# Operator test.  #
+BEGIN OP +:= = (INT a, b) INT: a + b;
+      OP +:= = (INT a, REAL b) INT: ROUND (a - b);
+
+      ASSERT ((2+:=1) = 3);
+      ASSERT ((2+:=1.0) = 1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/oper02.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Operator and balancing.  #
+BEGIN OP + = (UNION(INT,BOOL) a) INT: (a|(BOOL):1,(INT):2);
+      ASSERT (+IF TRUE THEN TRUE ELSE 0 FI = 1);
+      ASSERT (+IF FALSE THEN TRUE ELSE 0 FI = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/oper03.a68
@@ -0,0 +1,12 @@
+# { dg-options "-fstropping=upper" }  #
+# Operator priorities.  #
+BEGIN PRIO + = 7;
+      ASSERT ((1+2*3) = 9);
+      BEGIN PRIO + = 6;
+            ASSERT ((1+2*3) = 7);
+            FOR i TO 1 WHILE PRIO + = 7; TRUE
+            DO ASSERT ((1+2*3) = 9); OD;
+            ASSERT ((1+2*3) = 7)
+      END;
+      ASSERT ((1+2*3) = 9)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/oper04.a68
@@ -0,0 +1,21 @@
+# { dg-options "-fstropping=upper" }  #
+# Operator identification.  #
+BEGIN MODE M = UNION ([]INT, BOOL, STRING);
+
+      OP + = (REAL a) INT: 2;
+      OP + = (CHAR a) INT: 3;
+      OP + = (M    a) INT: 1;
+
+      PROC prpm = REF PROC M: HEAP PROC M := M : "aap";
+      UNION (BOOL, STRING) b = "b ";
+
+      FOR n TO 5
+      DO ASSERT ((+ CASE n
+                    IN SKIP,
+                       TRUE,
+                       IF FALSE THEN "aa" ELSE b FI,
+                       prpm
+                    OUT LOC[1:1]INT := 1
+                    ESAC) = 1)
+      OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/oper05.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# Operator test, mutual recursion.  #
+BEGIN PRIO +> = 1, +< = 1;
+      INT cnt := 0;
+      OP +> = (INT a, b) INT: IF (cnt +:= 1) = 10 THEN stop ELSE a +< b FI;
+      OP +< = (INT a, b) INT: IF (cnt +:= 1) = 10 THEN stop ELSE a +> b FI;
+      1 +> 2 # loop  #
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/oper07.a68
@@ -0,0 +1,12 @@
+# { dg-options "-fstropping=upper" }  #
+# Operator declarations.  #
+BEGIN OP SQ = (REAL x) REAL: x * x,
+         RD = (INT x) REAL: random,
+      OP (REAL)REAL SIN = (puts ("Print ten times 1\n"); sin),
+                    COS  = cos;
+
+      puts ("\n");
+      TO 10
+      DO REAL x = RD 1; SQ SIN x + SQ COS x OD;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/oper08.a68
@@ -0,0 +1,18 @@
+# { dg-options "-fstropping=upper" }  #
+# A complicated formula relying totally on priorities.  #
+(
+  OP I= (INT i, j) COMPL : (i, j);
+  OP ** = (INT i, COMPL z) INT : ROUND(i + RE z + IM z);
+  OP <  = (INT i, j) INT : (i - j) * 2;
+  OP =  = (INT i, j) INT : (i + j) * 2;
+  OP AND= (INT i, j) INT : (i + i - j) * 3;
+  OP OR= (INT i, j) INT : (i - j - j) * 3;
+
+  INT loc int;
+  # Note: all operators are followed by their priorities #
+  ASSERT (((loc int := 0) -:= 1 OR 2 AND 3 = 4 < 5 + 6 * 7 ** 8 I 9
+          -:= 1 ** 8 OR 2 * 7 AND 3 + 6 = 4 < 5) EQ 10650)
+  # The implied parenthesis structure is :
+    (1(2(3(4(5(6(7(8(9)))))))))1((8)2((7)3((6)4(5))))
+    and it yields 10650 #
+)
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/oper09.a68
@@ -0,0 +1,65 @@
+# { dg-options "-fstropping=upper" }  #
+# Monadic operators, non-bold monads.  #
+BEGIN INT decls := 0;
+      OP    += (INT a) INT: a + 1; decls +:= 1;
+      OP   +<= (INT a) INT: a + 1; decls +:= 1;
+      OP   +>= (INT a) INT: a + 1; decls +:= 1;
+      OP   +/= (INT a) INT: a + 1; decls +:= 1;
+      OP   +== (INT a) INT: a + 1; decls +:= 1;
+      OP   +*= (INT a) INT: a + 1; decls +:= 1;
+      OP  +:== (INT a) INT: a + 1; decls +:= 1;
+      OP +<:== (INT a) INT: a + 1; decls +:= 1;
+      OP +>:== (INT a) INT: a + 1; decls +:= 1;
+      OP +/:== (INT a) INT: a + 1; decls +:= 1;
+      OP +=:== (INT a) INT: a + 1; decls +:= 1;
+      OP +*:== (INT a) INT: a + 1; decls +:= 1;
+      OP  +=:= (INT a) INT: a + 1; decls +:= 1;
+      OP +<=:= (INT a) INT: a + 1; decls +:= 1;
+      OP +>=:= (INT a) INT: a + 1; decls +:= 1;
+      OP +/=:= (INT a) INT: a + 1; decls +:= 1;
+      OP +==:= (INT a) INT: a + 1; decls +:= 1;
+      OP +*=:= (INT a) INT: a + 1; decls +:= 1;
+
+      OP    -= (INT a) INT: a + 1; decls +:= 1;
+      OP   -<= (INT a) INT: a + 1; decls +:= 1;
+      OP   ->= (INT a) INT: a + 1; decls +:= 1;
+      OP   -/= (INT a) INT: a + 1; decls +:= 1;
+      OP   -== (INT a) INT: a + 1; decls +:= 1;
+      OP   -*= (INT a) INT: a + 1; decls +:= 1;
+      OP  -:== (INT a) INT: a + 1; decls +:= 1;
+      OP -<:== (INT a) INT: a + 1; decls +:= 1;
+      OP ->:== (INT a) INT: a + 1; decls +:= 1;
+      OP -/:== (INT a) INT: a + 1; decls +:= 1;
+      OP -=:== (INT a) INT: a + 1; decls +:= 1;
+      OP -*:== (INT a) INT: a + 1; decls +:= 1;
+      OP  -=:= (INT a) INT: a + 1; decls +:= 1;
+      OP -<=:= (INT a) INT: a + 1; decls +:= 1;
+      OP ->=:= (INT a) INT: a + 1; decls +:= 1;
+      OP -/=:= (INT a) INT: a + 1; decls +:= 1;
+      OP -==:= (INT a) INT: a + 1; decls +:= 1;
+      OP -*=:= (INT a) INT: a + 1; decls +:= 1;
+
+      OP    %= (INT a) INT: a + 1; decls +:= 1;
+      OP   %<= (INT a) INT: a + 1; decls +:= 1;
+      OP   %>= (INT a) INT: a + 1; decls +:= 1;
+      OP   %/= (INT a) INT: a + 1; decls +:= 1;
+      OP   %== (INT a) INT: a + 1; decls +:= 1;
+      OP   %*= (INT a) INT: a + 1; decls +:= 1;
+      OP  %:== (INT a) INT: a + 1; decls +:= 1;
+      OP %<:== (INT a) INT: a + 1; decls +:= 1;
+      OP %>:== (INT a) INT: a + 1; decls +:= 1;
+      OP %/:== (INT a) INT: a + 1; decls +:= 1;
+      OP %=:== (INT a) INT: a + 1; decls +:= 1;
+      OP %*:== (INT a) INT: a + 1; decls +:= 1;
+      OP  %=:= (INT a) INT: a + 1; decls +:= 1;
+      OP %<=:= (INT a) INT: a + 1; decls +:= 1;
+      OP %>=:= (INT a) INT: a + 1; decls +:= 1;
+      OP %/=:= (INT a) INT: a + 1; decls +:= 1;
+      OP %==:= (INT a) INT: a + 1; decls +:= 1;
+      OP %*=:= (INT a) INT: a + 1; decls +:= 1;
+
+      ASSERT (++<+>+/+=+*+:=+<:=+>:=+/:=+=:=+*:=+=:+<=:+>=:+/=:+==:+*=:
+              --<->-/-=-*-:=-<:=->:=-/:=-=:=-*:=-=:-<=:->=:-/=:-==:-*=:
+              %%<%>%/%=%*%:=%<:=%>:=%/:=%=:=%*:=%=:%<=:%>=:%/=:%==:%*=: 0 = decls)
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/oper10.a68
@@ -0,0 +1,87 @@
+# { dg-options "-fstropping=upper" }  #
+# Dyadic operators, non-bold monads #
+BEGIN # the first declaration is different to avoid a recursive loop #
+      INT decls := 0;
+      OP     += (INT a, b) INT: (INT c:= a; c PLUSAB b);
+      decls PLUSAB 1;
+      OP    +<= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    +>= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    +/= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    +== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    +*= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP   +:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  +<:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  +>:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  +/:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  +=:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  +*:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP   +=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  +<=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  +>=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  +/=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  +==:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  +*=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+
+      OP     -= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    -<= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    ->= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    -/= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    -== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    -*= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP   -:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  -<:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  ->:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  -/:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  -=:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  -*:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP   -=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  -<=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  ->=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  -/=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  -==:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  -*=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+
+      OP     %= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    %<= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    %>= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    %/= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    %== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP    %*= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP   %:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  %<:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  %>:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  %/:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  %=:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  %*:== (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP   %=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  %<=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  %>=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  %/=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  %==:= (INT a, b) INT: a + b; decls PLUSAB 1;
+      OP  %*=:= (INT a, b) INT: a + b; decls PLUSAB 1;
+
+      PRIO
+      +=1, +<=1, +>=1, +/=1, +==1, +*=1,
+      +:==1, +<:==1, +>:==1, +/:==1, +=:==1, +*:==1,
+      +=:=1, +<=:=1, +>=:=1, +/=:=1, +==:=1, +*=:=1,
+
+      -=1, -<=1, ->=1, -/=1, -==1, -*=1,
+      -:==1, -<:==1, ->:==1, -/:==1, -=:==1, -*:==1,
+      -=:=1, -<=:=1, ->=:=1, -/=:=1, -==:=1, -*=:=1,
+
+      %=1, %<=1, %>=1, %/=1, %==1, %*=1,
+      %:==1, %<:==1, %>:==1, %/:==1, %=:==1, %*:==1,
+      %=:=1, %<=:=1, %>=:=1, %/=:=1, %==:=1, %*=:=1;
+
+    ASSERT ((+ 1  +< 1  +> 1  +/ 1  += 1  +* 1
+    +:= 1  +<:= 1  +>:= 1  +/:= 1  +=:= 1  +*:= 1
+    +=: 1  +<=: 1  +>=: 1  +/=: 1  +==: 1  +*=: 1
+
+    - 1  -< 1  -> 1  -/ 1  -= 1  -* 1
+    -:= 1  -<:= 1  ->:= 1  -/:= 1  -=:= 1  -*:= 1
+    -=: 1  -<=: 1  ->=: 1  -/=: 1  -==: 1  -*=: 1
+
+    % 1  %< 1  %> 1  %/ 1  %= 1  %* 1
+    %:= 1  %<:= 1  %>:= 1  %/:= 1  %=:= 1  %*:= 1
+    %=: 1  %<=: 1  %>=: 1  %/=: 1  %==: 1  %*=: 1) EQ decls)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/oper11.a68
@@ -0,0 +1,141 @@
+# { dg-options "-fstropping=upper" }  #
+# Dyadic operators, non-bold nomads # 
+BEGIN INT decls := 0;
+
+      OP    <= (INT a, b) INT: a + b; decls +:= 1;
+      OP   <<= (INT a, b) INT: a + b; decls +:= 1;
+      OP   <>= (INT a, b) INT: a + b; decls +:= 1;
+      OP   </= (INT a, b) INT: a + b; decls +:= 1;
+      OP   <== (INT a, b) INT: a + b; decls +:= 1;
+      OP   <*= (INT a, b) INT: a + b; decls +:= 1;
+      OP  <:== (INT a, b) INT: a + b; decls +:= 1;
+      OP <<:== (INT a, b) INT: a + b; decls +:= 1;
+      OP <>:== (INT a, b) INT: a + b; decls +:= 1;
+      OP </:== (INT a, b) INT: a + b; decls +:= 1;
+      OP <=:== (INT a, b) INT: a + b; decls +:= 1;
+      OP <*:== (INT a, b) INT: a + b; decls +:= 1;
+      OP  <=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP <<=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP <>=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP </=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP <==:= (INT a, b) INT: a + b; decls +:= 1;
+      OP <*=:= (INT a, b) INT: a + b; decls +:= 1;
+
+      OP    >= (INT a, b) INT: a + b; decls +:= 1;
+      OP   ><= (INT a, b) INT: a + b; decls +:= 1;
+      OP   >>= (INT a, b) INT: a + b; decls +:= 1;
+      OP   >/= (INT a, b) INT: a + b; decls +:= 1;
+      OP   >== (INT a, b) INT: a + b; decls +:= 1;
+      OP   >*= (INT a, b) INT: a + b; decls +:= 1;
+      OP  >:== (INT a, b) INT: a + b; decls +:= 1;
+      OP ><:== (INT a, b) INT: a + b; decls +:= 1;
+      OP >>:== (INT a, b) INT: a + b; decls +:= 1;
+      OP >/:== (INT a, b) INT: a + b; decls +:= 1;
+      OP >=:== (INT a, b) INT: a + b; decls +:= 1;
+      OP >*:== (INT a, b) INT: a + b; decls +:= 1;
+      OP  >=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP ><=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP >>=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP >/=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP >==:= (INT a, b) INT: a + b; decls +:= 1;
+      OP >*=:= (INT a, b) INT: a + b; decls +:= 1;
+
+      OP    /= (INT a, b) INT: a + b; decls +:= 1;
+      OP   /<= (INT a, b) INT: a + b; decls +:= 1;
+      OP   />= (INT a, b) INT: a + b; decls +:= 1;
+      OP   //= (INT a, b) INT: a + b; decls +:= 1;
+      OP   /== (INT a, b) INT: a + b; decls +:= 1;
+      OP   /*= (INT a, b) INT: a + b; decls +:= 1;
+      OP  /:== (INT a, b) INT: a + b; decls +:= 1;
+      OP /<:== (INT a, b) INT: a + b; decls +:= 1;
+      OP />:== (INT a, b) INT: a + b; decls +:= 1;
+      OP //:== (INT a, b) INT: a + b; decls +:= 1;
+      OP /=:== (INT a, b) INT: a + b; decls +:= 1;
+      OP /*:== (INT a, b) INT: a + b; decls +:= 1;
+      OP  /=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP /<=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP />=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP //=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP /==:= (INT a, b) INT: a + b; decls +:= 1;
+      OP /*=:= (INT a, b) INT: a + b; decls +:= 1;
+
+      OP    == (INT a, b) INT: a + b; decls +:= 1;
+      OP   =<= (INT a, b) INT: a + b; decls +:= 1;
+      OP   =>= (INT a, b) INT: a + b; decls +:= 1;
+      OP   =/= (INT a, b) INT: a + b; decls +:= 1;
+      OP   === (INT a, b) INT: a + b; decls +:= 1;
+      OP   =*= (INT a, b) INT: a + b; decls +:= 1;
+      OP  =:== (INT a, b) INT: a + b; decls +:= 1;
+      OP =<:== (INT a, b) INT: a + b; decls +:= 1;
+      OP =>:== (INT a, b) INT: a + b; decls +:= 1;
+      OP =/:== (INT a, b) INT: a + b; decls +:= 1;
+      OP ==:== (INT a, b) INT: a + b; decls +:= 1;
+      OP =*:== (INT a, b) INT: a + b; decls +:= 1;
+      OP  ==:= (INT a, b) INT: a + b; decls +:= 1;
+      OP =<=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP =>=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP =/=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP ===:= (INT a, b) INT: a + b; decls +:= 1;
+      OP =*=:= (INT a, b) INT: a + b; decls +:= 1;
+
+      OP    *= (INT a, b) INT: a + b; decls +:= 1;
+      OP   *<= (INT a, b) INT: a + b; decls +:= 1;
+      OP   *>= (INT a, b) INT: a + b; decls +:= 1;
+      OP   */= (INT a, b) INT: a + b; decls +:= 1;
+      OP   *== (INT a, b) INT: a + b; decls +:= 1;
+      OP   **= (INT a, b) INT: a + b; decls +:= 1;
+      OP  *:== (INT a, b) INT: a + b; decls +:= 1;
+      OP *<:== (INT a, b) INT: a + b; decls +:= 1;
+      OP *>:== (INT a, b) INT: a + b; decls +:= 1;
+      OP */:== (INT a, b) INT: a + b; decls +:= 1;
+      OP *=:== (INT a, b) INT: a + b; decls +:= 1;
+      OP **:== (INT a, b) INT: a + b; decls +:= 1;
+      OP  *=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP *<=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP *>=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP */=:= (INT a, b) INT: a + b; decls +:= 1;
+      OP *==:= (INT a, b) INT: a + b; decls +:= 1;
+      OP **=:= (INT a, b) INT: a + b; decls +:= 1;
+
+      PRIO
+      <=1, <<=1, <>=1, </=1, <==1, <*=1,
+      <:==1, <<:==1, <>:==1, </:==1, <=:==1, <*:==1,
+      <=:=1, <<=:=1, <>=:=1, </=:=1, <==:=1, <*=:=1,
+
+      >=1, ><=1, >>=1, >/=1, >==1, >*=1,
+      >:==1, ><:==1, >>:==1, >/:==1, >=:==1, >*:==1,
+      >=:=1, ><=:=1, >>=:=1, >/=:=1, >==:=1, >*=:=1,
+
+      /=1, /<=1, />=1, //=1, /==1, /*=1,
+      /:==1, /<:==1, />:==1, //:==1, /=:==1, /*:==1,
+      /=:=1, /<=:=1, />=:=1, //=:=1, /==:=1, /*=:=1,
+
+      ==1, =<=1, =>=1, =/=1, ===1, =*=1,
+      =:==1, =<:==1, =>:==1, =/:==1, ==:==1, =*:==1,
+      ==:=1, =<=:=1, =>=:=1, =/=:=1, ===:=1, =*=:=1,
+
+      *=1, *<=1, *>=1, */=1, *==1, **=1,
+      *:==1, *<:==1, *>:==1, */:==1, *=:==1, **:==1,
+      *=:=1, *<=:=1, *>=:=1, */=:=1, *==:=1, **=:=1;
+
+    ASSERT ((0
+    < 1  << 1  <> 1  </ 1  <= 1  <* 1
+    <:= 1  <<:= 1  <>:= 1  </:= 1  <=:= 1  <*:= 1
+    <=: 1  <<=: 1  <>=: 1  </=: 1  <==: 1  <*=: 1
+
+    > 1  >< 1  >> 1  >/ 1  >= 1  >* 1
+    >:= 1  ><:= 1  >>:= 1  >/:= 1  >=:= 1  >*:= 1
+    >=: 1  ><=: 1  >>=: 1  >/=: 1  >==: 1  >*=: 1
+
+    / 1  /< 1  /> 1  // 1  /= 1  /* 1
+    /:= 1  /<:= 1  />:= 1  //:= 1  /=:= 1  /*:= 1
+    /=: 1  /<=: 1  />=: 1  //=: 1  /==: 1  /*=: 1
+
+    = 1  =< 1  => 1  =/ 1  == 1  =* 1
+    =:= 1  =<:= 1  =>:= 1  =/:= 1  ==:= 1  =*:= 1
+    ==: 1  =<=: 1  =>=: 1  =/=: 1  ===: 1  =*=: 1
+
+    * 1  *< 1  *> 1  */ 1  *= 1  ** 1
+    *:= 1  *<:= 1  *>:= 1  */:= 1  *=:= 1  **:= 1
+    *=: 1  *<=: 1  *>=: 1  */=: 1  *==: 1  **=: 1) EQ decls)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/oper14.a68
@@ -0,0 +1,32 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (UPB []INT(1,2,3,4) = 4);
+      ASSERT (UPB "abcde" = 5);
+      ASSERT (UPB []INT(SKIP,SKIP)[1:1@5] = 5);
+      ASSERT (2 UPB [,]INT(1,2)[,@4] = 4);
+
+      # All declarers are of the mode row-of, so UPB/LWB
+        should work.
+      #
+      ASSERT (UPB UNION([]INT,[,]INT)([]INT (1)) = 1);
+      ASSERT (UPB UNION([]INT,[,]INT)([,]INT (1,1)) = 2);
+      ASSERT (UPB UNION([]STRING,STRING)("ab") = 2);
+      ASSERT (LWB UNION([]INT,[,]INT)([]INT (1)) = 1);
+      ASSERT (LWB UNION([]INT,[,]INT)([,]INT (1,1)) = 1);
+      ASSERT (LWB UNION([]STRING,STRING)("ab") = 1);
+
+      ASSERT (1 UPB [,,]CHAR ("abc", "def") = 2);
+      ASSERT (2 UPB [,,]CHAR ("abc", "def") = 1);
+      ASSERT (3 UPB [,,]CHAR ("abc", "def") = 3);
+
+      ASSERT (LWB LOC STRING LWB LOC STRING = 1);
+
+      # Balance.  #
+      FOR n TO 4
+      DO n UPB CASE n
+               IN []INT (1),
+                  [,]REAL (1),
+                  UNION([]INT,[,,]BOOL) ([,,]BOOL (TRUE)),
+                  UNION([]INT,UNION([,]REAL,[,,,]CHAR))([,,,]CHAR ("a"))
+               ESAC
+      OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/oper16.a68
@@ -0,0 +1,866 @@
+# { dg-options "-fstropping=upper" }  #
+# Tests  on  operators.  #
+BEGIN
+      PROC itoa = (INT i) STRING:
+      BEGIN IF i = 0
+            THEN "0"
+            ELSE INT n := ABS i;
+                 STRING res;
+                 WHILE n /= 0
+                 DO INT rem = n %* 10;
+                    res := REPR (rem > 9
+                                 | (rem - 10) + ABS "a"
+                                 | rem + ABS "0") + res;
+                    n %:= 10
+                 OD;
+                 (i < 0 | "-" + res | res)
+            FI
+      END;
+
+    INT errors := 0;
+    PROC error = (INT i) VOID:
+       (puts("Error in test " + itoa (i)); errors +:= 1);
+
+    PROC tste = (INT i) VOID:
+    BEGIN error(i);
+          puts ("; wrong branch taken\n")
+    END;
+
+    PROC tsti = (INT i, INT p, q) VOID:
+    IF p = q THEN SKIP
+    ELSE error(i);
+         puts ("; value is: " + itoa (q) + ", must be: " + itoa (p) + "\n")
+    FI;
+
+    PROC tstr = (INT i, REAL p, q) VOID:
+    # two reals are considered equal if their difference is negligible
+      compared to one of them
+    #
+    IF p + (p-q)/8 = p THEN SKIP
+    ELSE error(i);
+         errors -:= 1; # XXX Optimizations make comparisons to fail.  #
+         puts ("; real values are not equal\n")
+    FI;
+
+    PROC tstb = (INT i, BOOL p, q) VOID:
+    BEGIN
+        IF p THEN IF q THEN SKIP ELSE GOTO bad FI
+               ELSE IF q THEN GOTO bad ELSE SKIP FI
+        FI
+    EXIT bad:
+        error(i);
+        puts ("; boolean values are not equal\n")
+    END;
+
+    PROC tstc = (INT i, CHAR p, q) VOID:
+    IF p = q THEN SKIP
+    ELSE error(i);
+         puts ("; value is: " + q + ", must be: " + p + "\n")
+    FI;
+
+    PROC tstli = (INT i, LONG INT p, q) VOID:
+    IF p = q THEN SKIP
+    ELSE error(i);
+         puts ("; long int values are not equal\n")
+    FI;
+
+    PROC tstlr = (INT i, LONG REAL p, q) VOID:
+    IF p + (p-q)/LONG 8 = p THEN SKIP
+    ELSE error(i);
+         errors -:= 1; # XXX Optimizations make comparisons to fail.  #
+         puts ("; long real values are not equal\n")
+    FI;
+
+puts("Test: REPR, ABS\n");
+BEGIN
+    INT b1; LONG INT b2;
+    INT b0 = 44;
+    [1:2]CHAR a;
+    a[2]:="a";
+    tstc(1, "a", REPR ABS"a");
+    tstc(2, "a", REPR ABS a[2]);
+    tsti(3, +43, ABS(REPR 43));
+    tsti(4, +44, ABS(REPR b0));
+    b1:=45;
+    tsti(5, +45, ABS(REPR b1));
+    tsti(6, +46, ABS(REPR (46+0)));
+    b2:=LONG 43;
+    tsti(7, +43, ABS(REPR SHORTEN b2));
+    tsti(8, +46, ABS REPR SHORTEN LONG 46)
+END;
+
+puts("Test: LWB, UPB\n");
+BEGIN
+    REF[]CHAR b;
+    [-5:-3, -1:3]REF[ , ]REAL a;
+    tsti(9, -5, 1 LWB a);
+    tsti(10, -5, LWB a);
+    tsti(11, -1, 2 LWB a);
+    tsti(12, -3, 1 UPB a);
+    tsti(13, -3, UPB a);
+    tsti(14, +3, 2 UPB a);
+    FOR i FROM LWB a BY 1 TO UPB a DO
+    FOR j FROM 2 LWB a BY 1 TO 2 UPB a DO
+        BEGIN
+            [i:j, -j:-i]REAL b;
+            a[i, j] := b;
+            tsti(15,  i, 1 LWB a[i, j]);
+            tsti(16,  j, UPB a[i, j]);
+            tsti(17, -j, 2 LWB a[i, j]);
+            tsti(18, -i, 2 UPB a[i, j])
+        END
+    OD OD
+END;
+
+BEGIN
+    [1:3, 2:4, 3:5]INT a aaaaa;
+    INT jjjjjj;
+    FOR i FROM 1 BY 1 TO 3
+    DO tsti(19, i, i LWB aaaaaa);
+            tsti(20, i+2, i UPB aaaaaa)
+    OD;
+    FOR i FROM-3BY 1 TO-1
+    DO tsti(21, -i, -i LWB aaaaaa);
+            tsti(22, 2-i, -i UPB aaaaaa)
+    OD;
+    jjjjjj:=2; tsti(23, +2, jjjjjj LWB aaaaaa);
+               tsti(24, +4, jjjjjj UPB aaaaaa);
+    tsti(25, +1, LWB"abc");
+    tsti(26, +3, UPB"cde");
+    tsti(27, +1, (1+0) LWB"abc");
+    tsti(28, +3, 1 UPB"efg")
+END;
+
+puts("Test: OR, AND\n");
+BEGIN
+    BOOL t = TRUE; BOOL f = FALSE;
+    BOOL a;
+    a:=t OR t; tstb(29, TRUE, a);
+    a:=t OR f; tstb(30, TRUE, a);
+    a:=f OR t; tstb(31, TRUE, a);
+    a:=f OR f; tstb(32, FALSE, a);
+    a:=t AND t; tstb(33, TRUE, a);
+    a:=t AND f; tstb(34, FALSE, a);
+    a:=f AND t; tstb(35, FALSE, a);
+    a:=f AND f; tstb(36, FALSE, a);
+    a:=NOT t AND t; tstb(37, FALSE, a);
+    a:=NOT f AND t; tstb(38, TRUE, a);
+    a:=NOT t AND f; tstb(39, FALSE, a);
+    a:=NOT f AND f; tstb(40, FALSE, a);
+    a:=NOT t OR t; tstb(41, TRUE, a);
+    a:=NOT f OR t; tstb(42, TRUE, a);
+    a:=NOT t OR f; tstb(43, FALSE, a);
+    a:=NOT f OR f; tstb(44, TRUE, a);
+    a:=t AND NOT t; tstb(45, FALSE, a);
+    a:=t AND NOT f; tstb(46, TRUE, a);
+    a:=f AND NOT t; tstb(47, FALSE, a);
+    a:=f AND NOT f; tstb(48, FALSE, a);
+    a:=t OR NOT t; tstb(49, TRUE, a);
+    a:=t OR NOT f; tstb(50, TRUE, a);
+    a:=f OR NOT t; tstb(51, FALSE, a);
+    a:=f OR NOT f; tstb(52, TRUE, a);
+    a:=NOT t AND NOT t; tstb(53, FALSE, a);
+    a:=NOT t AND NOT f; tstb(54, FALSE, a);
+    a:=NOT f AND NOT t; tstb(55, FALSE, a);
+    a:=NOT f AND NOT f; tstb(56, TRUE, a);
+    a:=NOT t OR NOT t; tstb(57, FALSE, a);
+    a:=NOT t OR NOT f; tstb(58, TRUE, a);
+    a:=NOT f OR NOT t; tstb(59, TRUE, a);
+    a:=NOT f OR NOT f; tstb(60, TRUE, a);
+
+    a:=t; tstb(61, TRUE, a);
+    a:=a AND t; tstb(62, TRUE, a);
+    a:=a OR t; tstb(63, TRUE, a);
+    a:=a OR f; tstb(64, TRUE, a);
+    a:=a AND f; tstb(65, FALSE, a);
+    a:=a AND f; tstb(66, FALSE, a);
+    a:=a AND t; tstb(67, FALSE, a);
+    a:=a OR f; tstb(68, FALSE, a);
+    a:=a OR t; tstb(69, TRUE, a);
+    a:=t; tstb(70, TRUE, a);
+    a:=t AND a; tstb(71, TRUE, a);
+    a:=t OR a; tstb(72, TRUE, a);
+    a:=f OR a; tstb(73, TRUE, a);
+    a:=f AND a; tstb(74, FALSE, a);
+    a:=f AND a; tstb(75, FALSE, a);
+    a:=t AND a; tstb(76, FALSE, a);
+    a:=f OR a; tstb(77, FALSE, a);
+    a:=t OR a; tstb(78, TRUE, a);
+    SKIP
+END;
+
+BEGIN
+    BOOL t = TRUE; BOOL f = FALSE;
+    tstb(79, TRUE, t OR f);
+    tstb(80, TRUE, t OR t);
+    tstb(81, TRUE, f OR t);
+    tstb(82, FALSE, f OR f);
+    tstb(83, TRUE, NOT (f OR f));
+    tstb(84, TRUE, NOT (f AND f));
+    tstb(85, TRUE, t AND t);
+    tstb(86, FALSE, t AND f);
+    tstb(87, FALSE, f AND t);
+    tstb(88, FALSE, f AND f);
+    tstb(89, TRUE, (t OR t) OR (f OR f));
+    tstb(90, FALSE, (t OR t) AND (f OR f));
+    tstb(91, TRUE, t OR (f OR f));
+    tstb(92, TRUE, NOT (t AND (f OR f)));
+    tstb(93, FALSE, NOT NOT ((f OR f) OR f));
+    tstb(94, TRUE, NOT NOT NOT ((f OR f) AND f));
+    IF t OR f THEN SKIP ELSE tste(95) FI;
+    IF t OR t THEN SKIP ELSE tste(96) FI;
+    IF f OR t THEN SKIP ELSE tste(97) FI;
+    IF f OR f THEN tste(98) FI;
+    IF NOT (f OR f) THEN SKIP ELSE tste(99) FI;
+    IF NOT (f AND f) THEN SKIP ELSE tste(100) FI;
+    IF t AND t THEN SKIP ELSE tste(101) FI;
+    IF t AND f THEN tste(102) FI;
+    IF f AND t THEN tste(103) FI;
+    IF f AND f THEN tste(104) FI;
+    IF (t OR t) AND (t OR t) THEN SKIP ELSE tste(105) FI;
+    IF (t OR t) OR (t OR t) THEN SKIP ELSE tste(106) FI;
+    IF (t OR t) OR f THEN SKIP ELSE tste(107) FI;
+    IF (t OR t) AND t THEN SKIP ELSE tste(108) FI;
+    IF t OR (t OR t) THEN SKIP ELSE tste(109) FI;
+    IF t AND (t OR f) THEN SKIP ELSE tste(110) FI;
+    BOOL a1; a1:=t AND f; tstb(111, FALSE, a1);
+    BOOL a2; a2:=NOT (t OR f); tstb(112, FALSE, a2);
+    BEGIN
+        BOOL t; t := TRUE;
+        BOOL f; f:=FALSE;
+        IF (NOT (NOT ((t OR t) AND (t OR t)) OR
+                ((f OR f) OR f) AND (t OR f AND f)) AND f)
+                OR NOT t
+        THEN tste(113) ELSE SKIP FI;
+        BOOL x; x:=
+            (NOT (NOT ((t OR t) AND (t OR t)) OR
+            ((f OR f) OR f) AND (t OR (f AND f))) AND f)
+            OR NOT t;
+        tstb(114, FALSE, x);
+        BOOL y =
+            (NOT (NOT ((t OR t) AND (t OR t)) OR
+            ((f OR f) OR f) AND (t OR (f AND f))) AND f)
+            OR NOT t;
+        tstb(115, FALSE, y)
+    END
+END;
+
+puts("Test: NE, EQ for booleans\n");
+BEGIN
+    BOOL t = TRUE; BOOL f = FALSE;
+    tstb(116, TRUE, t NE f);
+    tstb(117, FALSE, t NE t);
+    tstb(118, TRUE, f NE t);
+    tstb(119, FALSE, f NE f);
+    tstb(120, TRUE, NOT (f NE f));
+    tstb(121, FALSE, NOT (f EQ f));
+    tstb(122, TRUE, t EQ t);
+    tstb(123, FALSE, t EQ f);
+    tstb(124, FALSE, f EQ t);
+    tstb(125, TRUE, f EQ f);
+    tstb(126, FALSE, (t NE t) NE (f NE f));
+    tstb(127, TRUE, (t NE t) EQ (f NE f));
+    tstb(128, TRUE, t NE (f NE f));
+    tstb(129, TRUE, NOT (t EQ (f NE f)));
+    tstb(130, FALSE, NOT NOT ((f NE f) NE f));
+    tstb(131, FALSE, NOT NOT NOT ((f NE f) EQ f));
+    IF t NE f THEN SKIP ELSE tste(132) FI;
+    IF t NE t THEN tste(133) FI;
+    IF f NE t THEN SKIP ELSE tste(134) FI;
+    IF f NE f THEN tste(135) FI;
+    IF NOT (f NE f) THEN SKIP ELSE tste(136) FI;
+    IF NOT (f EQ f) THEN tste(137) FI;
+    IF t EQ t THEN SKIP ELSE tste(138) FI;
+    IF t EQ f THEN tste(139) FI;
+    IF f EQ t THEN tste(140) FI;
+    IF f EQ f THEN SKIP ELSE tste(141) FI;
+    IF (t NE t) EQ (t NE t) THEN SKIP ELSE tste(142) FI;
+    IF (t NE t) NE (t NE t) THEN tste(143) FI;
+    IF (t NE t) NE f THEN tste(144) FI;
+    IF (t NE t) EQ t THEN tste(145) FI;
+    IF t NE (t NE t) THEN SKIP ELSE tste(146) FI;
+    IF t EQ (t NE f) THEN SKIP ELSE tste(147) FI;
+    BOOL a1; a1:=t EQ f; tstb(148, FALSE, a1);
+    BOOL a2; a2:=NOT (t NE f); tstb(149, FALSE, a2);
+    BEGIN
+        BOOL t; t := TRUE;
+        BOOL f; f:=FALSE;
+        IF (NOT (NOT ((t NE t) EQ (t NE t)) NE
+                ((f NE f) NE f) EQ (t NE f EQ f)) EQ f)
+                NE NOT t
+        THEN SKIP ELSE tste(150) FI;
+        BOOL x; x:=
+            (NOT (NOT ((t NE t) EQ (t NE t)) NE
+            ((f NE f) NE f) EQ (t NE (f EQ f))) EQ f)
+            NE NOT t;
+        tstb(151, TRUE, x);
+        BOOL y =
+            (NOT (NOT ((t NE t) EQ (t NE t)) NE
+            ((f NE f) NE f) EQ (t NE (f EQ f))) EQ f)
+            NE NOT t;
+        tstb(152, TRUE, y)
+    END
+END;
+
+puts("Test: NOT\n");
+BEGIN
+    BOOL a1, a2, a3, b1, b2, b3;
+    BOOL a4=NOT FALSE; BOOL a5=NOT NOT FALSE;
+    BOOL a6=NOT NOT NOT FALSE;
+    BOOL a7=NOT a6; BOOL a8=NOT a7; BOOL a9=NOT NOT a8;
+    BOOL a10=NOT NOT NOT a9;
+    IF NOT TRUE THEN tste(153) FI;
+    IF NOT NOT TRUE THEN SKIP ELSE tste(154) FI;
+    IF NOT NOT NOT TRUE THEN tste(155) FI;
+    a1:=NOT TRUE; a2:=NOT NOT FALSE;
+    a3:=NOT NOT NOT TRUE;
+    b1:=NOT TRUE AND FALSE;
+    b2:=NOT NOT TRUE AND FALSE;
+    b3:=TRUE OR NOT NOT NOT TRUE OR FALSE;
+    tstb(156, FALSE, a1);
+    tstb(157, FALSE, a2);
+    tstb(158, FALSE, a3);
+    tstb(159, TRUE, a4);
+    tstb(160, FALSE, a5);
+    tstb(161, TRUE, a6);
+    tstb(162, FALSE, a7);
+    tstb(163, TRUE, a8);
+    tstb(164, TRUE, a9);
+    tstb(165, FALSE, a10);
+    tstb(166, FALSE, b1);
+    tstb(167, FALSE, b2);
+    tstb(168, TRUE, b3)
+END;
+
+puts("Test: EQ, NE, LT, LE, GT, GE\n");
+BEGIN
+    IF -1=-1 THEN SKIP ELSE tste(169) FI;
+    tstb(170, TRUE, -LONG 1=-LONG 1);
+    IF -1/=1 THEN SKIP ELSE tste(171) FI;
+    tstb(172, TRUE, -LONG 1/=LONG 1);
+    IF 1 /= -1 THEN SKIP ELSE tste(173) FI;
+    tstb(174, TRUE, LONG 1/=-LONG 1);
+    IF 1 =1 THEN SKIP ELSE tste(175) FI;
+    tstb(176, TRUE, LONG 1=LONG 1);
+    IF 0=0.0 THEN SKIP ELSE tste(177) FI;
+    tstb(178, TRUE, LONG 0=LONG 0.0);
+    IF 1.0=1 THEN SKIP ELSE tste(179) FI;
+    tstb(180, TRUE, LONG 1.0=LONG 1);
+    IF -1.0=-1.0 THEN SKIP ELSE tste(181) FI;
+    tstb(182, TRUE, -LONG 1.0=-LONG 1.0);
+    IF -1.0/=1.0 THEN SKIP ELSE tste(183) FI;
+    tstb(184, TRUE, LENG-1.0/=LONG 1.0);
+    IF 1.0/= -1.0 THEN SKIP ELSE tste(185) FI;
+    tstb(186, TRUE, LONG 1.0/=LENG-1.0);
+    BOOL
+    a1=1=1, a2=1/=1, a3=1>1,
+    a4=1<1, a5=1<= 1, a6=1>=0,
+    a7=1.0=2.0, a8=1.0/=2.0, a9=1.0<2.0,
+    a10=1.0>0.0, a11=1.0<=1.0,
+    a12=1.0>=-1.0;
+    tstb(187, TRUE, a1);
+    tstb(188, FALSE, a2);
+    tstb(189, FALSE, a3);
+    tstb(190, FALSE, a4);
+    tstb(191, TRUE, a5);
+    tstb(192, TRUE, a6);
+    tstb(193, FALSE, a7);
+    tstb(194, TRUE, a8);
+    tstb(195, TRUE, a9);
+    tstb(196, TRUE, a10);
+    tstb(197, TRUE, a11);
+    tstb(198, TRUE, a12);
+    IF 1 = 1 THEN SKIP ELSE tste(199) FI;
+    tstb(200, TRUE, 1=1);
+    IF NOT (1/=1) THEN SKIP ELSE tste(201) FI;
+    tstb(202, TRUE, NOT NOT NOT (1/=1));
+    IF 1/=2 AND 2/=3 AND 4/=5 THEN SKIP ELSE tste(203) FI
+END;
+
+BEGIN
+    REAL j;
+    [-3 : 3] BOOL lt0;
+    lt0[-3]:= lt0[-2]:= lt0[-1]:= TRUE;
+    lt0[0]:= lt0[1]:= lt0[2]:= lt0[3]:= FALSE;
+    FOR i FROM -3 BY 1 TO 3
+    DO
+        tstb(204, NOT(lt0[i] OR lt0[-i]), i=0);
+        tstb(205, lt0[i] OR lt0[-i], i/=0);
+        tstb(206, lt0[-i], i>0);
+        tstb(207, NOT lt0[i], i>=0);
+        tstb(208, lt0[i], i<0);
+        tstb(209, NOT lt0[-i], i<=0);
+        j:=i;
+        tstb(210, NOT(lt0[i] OR lt0[-i]), j=0);
+        tstb(211, lt0[i] OR lt0[-i], j/=0);
+        tstb(212, lt0[-i], j>0);
+        tstb(213, NOT lt0[i], j>=0);
+        tstb(214, lt0[i], j<0);
+        tstb(215, NOT lt0[-i], j<=0)
+    OD
+END;
+
+puts("Test: monadic -\n");
+BEGIN
+    INT x0, x1, x2, x3; LONG INT z0, z1, z2, z3;
+    REAL y0, y1, y2, y3; LONG REAL t0, t1, t2, t3;
+    INT x4 = 10; LONG INT z4 = LONG 10;
+    REAL y4 = x4; LONG REAL t4 = z4;
+    z0 := --LONG 38; z1 := -LONG 1000000000; z2 := -z1;
+    x0:=--79; x1 := -1; x2 := -x1; x3 := -SHORTEN z0;
+    t0 := --LONG 8.7; t1 := -LONG 79.99e-2; t2 := -t1;
+    y0 := --6.7e-4; y1 := -39.47e-2; y2 := -y1; y3 := -SHORTEN t2;
+    tsti(216, +79, x0);
+    tsti(217, -1, x1);
+    tsti(218, +1, x2);
+    tsti(219, -38, x3);
+    tsti(220, +10, x4);
+    tstli(221, +LONG 38, z0);
+    tstli(222, -LONG 1000000000, z1);
+    tstli(223, +LONG 1000000000, z2);
+    tstli(224, +LONG 10, z4);
+    tstr(225, +6.7e-4, y0);
+    tstr(226, -3.947e-1, y1);
+    tstr(227, +3.947e-1, y2);
+    tstr(228, -7.999e-1, y3);
+    tstr(229, +1e+1, y4);
+    tstlr(230, +LONG 8.7e+0, t0);
+    tstlr(231, -LONG 7.999e-1, t1);
+    tstlr(232, +LONG 7.999e-1, t2);
+    tstlr(233, +LONG 10e+0, t4)
+END;
+
+puts("Test: dyadic -\n");
+BEGIN
+    tsti(234, -2, 1-3);
+    tstli(235, +LONG 4, LONG 7-LONG 3);
+    tsti(236, -4, -1-3);
+    tstli(237, -LONG 13, -LONG 8-LONG 5);
+    tsti(238, +4, 1--3);
+    tstli(239, +LONG 7, LONG 4--LONG 3);
+    tsti(240, +2, -1--3);
+    tstli(241, -LONG 10, -LONG 5--LENG-5);
+
+    tstr(242, -6.4e+0, 1-7.4);
+    tstlr(243, +LONG 8e+0, LONG 4-LENG-4.0);
+    tstr(244, +6.4e+0, 7.4-1);
+    tstlr(245, -LONG 1.2e+1, -LONG 6.0-LONG 6);
+    tstr(246, +1.22e+1, 6.1--6.1);
+    tstlr(247, +LONG 8.6e+0, LONG 4.3--LONG 4.3);
+
+    tsti(248, +29999, 30000-1);
+    tstli(249, +LONG 999999998, LONG 1000000000-LONG 2);
+
+    tstr(250, +1e+0, -1.0-(-1.0-(-1.0-(-1.0-1))));
+    tstlr(251, +LONG 0e+0,
+        -LONG 1.0-(-LONG 1.0-(-LONG 1.0-(-LONG 1.0
+        -(LONG 1-LONG 1.0)))))
+END;
+
+puts("Test: dyadic +\n");
+BEGIN
+    tsti(252, +4, 1+3);
+    tstli(253, +LONG 10, LONG 7+LONG 3);
+    tsti(254, +2, -1+3);
+    tstli(255, -LONG 3, -LONG 8+LONG 5);
+    tsti(256, -2, 1+-3);
+    tstli(257, +LONG 1, LONG 4+-LONG 3);
+    tsti(258, -4, -1+-3);
+    tstli(259, +LONG 0, -LONG 5+-LENG-5);
+
+    tstr(260, +8.4e+0, 1+7.4);
+    tstlr(261, +LONG 0e+0, LONG 4+LENG-4.0);
+    tstr(262, +8.4e+0, 7.4+1);
+    tstlr(263, +LONG 0e+0, -LONG 6.0+LONG 6);
+    tstr(264, +0e+0, 6.1+-6.1);
+    tstlr(265, +LONG 0e+0, LONG 4.3+-LONG 4.3);
+
+    tsti(266, -29999, -30000+1);
+    tstli(267, -LONG 999999998, -LONG 1000000000+LONG 2);
+
+    tstr(268, -3e+0, -1.0+(-1.0+(-1.0+(-1.0+1))));
+    tstlr(269, -LONG 2e+0,
+        -LONG 1.0+(-LONG 1.0+(-LONG 1.0+(-LONG 1.0
+        +(LONG 1+LONG 1.0)))))
+END;
+
+puts("Test: ABS\n");
+BEGIN
+    tsti(270, +19, ABS 19);
+    tsti(271, +19, ABS-19);
+    tsti(272, +0, ABS 0);
+    tsti(273, +32, SHORTEN ABS LONG 32);
+    tsti(274, +43, SHORTEN ABS-LONG 43);
+    tsti(275, +0, SHORTEN ABS LONG 0);
+    tstr(276, +1.97e+2, ABS 197.0);
+    tstr(277, +4.97e+1, ABS-49.7);
+    tstr(278, +0e+0, ABS .0);
+    tstr(279, +1e+0, SHORTEN ABS LONG 1.0);
+    tstr(280, +0e+0, SHORTEN ABS LONG 0.0e+7);
+    tstr(281, +1.9e+0, SHORTEN ABS-LONG 1.9)
+END;
+
+puts("Test: * for integers\n");
+BEGIN
+    tsti(282, +6, 2*3);
+    tsti(283, -6, -2*3);
+    tsti(284, -6, 2*-3);
+    tsti(285, +6, -2*-3);
+    tsti(286, +6, SHORTEN(-LONG 2*-LONG 3));
+    tsti(287, -6, SHORTEN(LONG 2*-LONG 3));
+    tsti(288, -6, SHORTEN(-LONG 2*LONG 3));
+    tsti(289, +6, SHORTEN(LONG 2*LONG 3));
+    tsti(290, +0, 0*10);
+    tstli(291, +LONG 0, LONG 0*-LONG 10);
+    tsti(292, +0, 10*0);
+    tstli(293, +LONG 0, -LONG 10*LENG 0);
+    tsti(294, +3, 1*3);
+    tstli(295, +LONG 3, LONG 3*LONG 1);
+    tsti (296, +16384, 2*(2*(2*(2*(2*(2*(2*(2*(2*(2*(2*(2*(2*(2
+        ))))))))))))))
+END;
+
+puts("Test: * mixed\n");
+BEGIN
+    REAL a1=1.0; LONG REAL a2=-LONG 1.0;
+    REAL a3; LONG REAL a4;
+    tstr(297, +4.2e+1, 6.0*7.0);
+    tstlr(298, +LONG 2.6e+1, LONG 13.0*LONG 2.0);
+    tstr(299, -4.2e+1, -6.0*7.0);
+    tstlr(300, -LONG 6e+0, -LONG 2.0*LONG 3.0);
+    tstr(301, -5.6e+1, 7.0*-8.0);
+    tstlr(302, -LONG 4.8e+1, LONG 16.0*-LENG 3.0);
+    tstr(303, +5.6e+1, -8.0*-7.0);
+    tstlr(304, +LONG 2.5e+1, -LENG 5.0*-LONG 5.0);
+
+    tstr(305, +4.2e+1, 7*6.0);
+    tstlr(306, +LONG 2.1e+1, LONG 3*LONG 7.0);
+    tstr(307, +4.2e+1, 6.0*7);
+    tstlr(308, +LONG 3.6e+1, LONG 6.0*LONG 6);
+    tstr(309, +4.2e+1, -7*-6.0);
+    tstlr(310, +LONG 2.25e+2, -LONG 15*-LONG 15.0);
+    tstr(311, +4.2e+1, -6.0*-7);
+    tstlr(312, +LONG 1.9e+1, -LONG 19.0*-LONG 1);
+
+    a3:=14.0; a4:=LENG-13.0;
+    tstr(313, +1.4e+1, a3*a1);
+    tstlr(314, +LONG 1.3e+1, a2*a4);
+    tstr(315, +10e-43, 1.0e-20*1.0e-22);
+    tstlr(316, +LONG 10e+39, LONG 1.0e+20*LONG 1.0e+20)
+END;
+
+puts("Test: OVER, MOD\n");
+BEGIN
+    tsti(317, +2, 12 OVER 6);
+    tsti(318, -5, -20 OVER 4);
+    tsti(319, -25, 100 OVER -4);
+    tsti(320, +10, -10 OVER -1);
+    tsti(321, +2, 7 OVER 3);
+    tsti(322, -2, -8 OVER 3);
+    tsti(323, -1, 10 OVER -7);
+    tsti(324, +1, -49 OVER -27);
+    tsti(325, +3, SHORTEN(LONG 10 OVER LONG 3));
+    tsti(326, -1, SHORTEN(-LONG 50 OVER LONG 50));
+    tsti(327, -1, -12 OVER 7);
+    tsti(328, -1, 12 OVER -7);
+    tsti(329, -1, SHORTEN(-LONG 50 OVER LONG 50));
+    tsti(330, +0, SHORTEN(LONG 0 OVER -LONG 25));
+    tsti(331, +0, 12 MOD 6);
+    tsti(332, +0, -20 MOD 4);
+    tsti(333, +0, 100 MOD -4);
+    tsti(334, +0, -10 MOD -1);
+    tsti(335, +1, 7 MOD 3);
+    tsti(336, +1, -8 MOD 3);
+    tsti(337, +3, 10 MOD -7);
+    tsti(338, +5, -49 MOD -27);
+    tsti(339, +1, SHORTEN(LONG 10 MOD LONG 3));
+    tsti(340, +0, SHORTEN(-LONG 50 MOD LONG 50));
+    tsti(341, +2, -12 MOD 7);
+    tsti(342, +5, 12 MOD -7);
+    tsti(343, +0, SHORTEN(-LONG 50 MOD LONG 50));
+    tsti(344, +0, SHORTEN(LONG 0 MOD -LONG 25))
+END;
+
+puts("Test: /\n");
+BEGIN
+    REAL a, b; LONG REAL c, d; REAL x = 127.0;
+    FOR i FROM -3 BY 1 TO 3 DO
+    FOR j FROM -3 BY 1 TO 3 DO
+        IF j /= 0 THEN
+            a:=i/j;
+            tstr(345, i, a*j);
+            a:=i; a:=a/j;
+            tstr(346, i, a*j);
+            a:=j; a :=i/a;
+            tstr(347, i, a*j);
+            a := i; b := j; a := a/b;
+            tstr(348, i, a*j);
+            c := LENG i/LENG j;
+            tstlr(349, LENG i, c*LENG j);
+            c := LENG i; c := c/LENG j;
+            tstlr(350, LENG i, c*LENG j);
+            c := LENG j; c :=LENG i/c;
+            tstlr(351, LENG i, c*LENG j);
+            c := LENG i; d:=LENG j; c:=c/d;
+            tstlr(352, LENG i, c*LENG j)
+        FI
+    OD OD;
+    tstr(353, -1e+0, 1.9e-7/-1.9e-7);
+    a:=19.74e+2;
+    tstr(354, +1e+0, 19.74e+2/a);
+    tstr(355, +10e-5, 19.74e-2/19.74e+2);
+    tstr(356, +1e+3, 127000.0/x);
+    tstr(357, +1e+2, x/1.27);
+    tstr(358, -1e+1, x/-12.7);
+    tstr(359, +1e+0, x/x);
+    a:=1270.0;
+    tstr(360, +10e-2, x/a);
+    a:=0.0149; tstr(361, +1e+0, a/149e-4);
+    tstr(362, +1e+0, a/a);
+    tstr(363, +1.173228346456693e-4, a/x);
+    tstr(364, -1e-2, a/-1.49);
+    tstr(365, +1.27e+2, -x/-1.0);
+    tstr(366, -1e+0, -x/x);
+    tstr(367, -8.523489932885906e+3, -x/a);
+    tstr(368, +1e+0, -x/-x)
+END;
+
+puts("Test: **\n");
+BEGIN
+    INT a;
+    tsti(369, +1, 1**0);
+    tsti(370, +1, 10**0);
+    tsti(371, +1, -20**0);
+    tsti(372, +1, 1**1);
+    tsti(373, +10, 10**1);
+    tsti(374, -10, -10**1);
+    tsti(375, +0, 0**1);
+    tsti(376, +0, 0**30000);
+    tsti(377, +1, 0**0);
+    tsti(378, +49, 7**2);
+    tsti(379, +1, 1**2);
+    tsti(380, +9, -3**2);
+    tsti(381, -27, -3**3);
+    tsti(382, +32, 2**5);
+    tsti(383, +81, SHORTEN(LONG 9**2));
+    tsti(384, -19683, SHORTEN(-LONG 27**3));
+    tstr(385, +2.7e+1, 3.0**3);
+    tstr(386, +6.5536e+4, 2.0**16);
+    tstr(387, -3.2768e+4, -2.0**15);
+    tstr(388, +3.6e+1, -6.0**2);
+    tstr(389, +2.5e-1, 2.0**-2);
+    tstr(390, -10e-4, -10.0**-3);
+    tstr(391, +1e+0, 3.0**-0);
+    tstr(392, +1e+0, 3.0**-0);
+    tstr(393, +4.9e+1, SHORTEN(LONG 7.0**2));
+    tstr(394, +3.969e+1, SHORTEN(-LONG 6.3**2));
+    tstr(395, +1.385019350059107e-8, SHORTEN(LONG 37.3**-5));
+    a:= 1;
+    FOR i FROM 1 BY 1 TO 10
+    DO  tsti(396, a, (-1)**(i-1)); a:= -a OD;
+    a:= 0;
+    FOR i FROM 1 BY 1 TO 10
+    DO a := a + 1**30000 OD;
+    tsti(397, +10, a)
+END;
+
+puts("Test: SHORTEN, LENG\n");
+BEGIN
+    LONG INT a1 = LONG 128; LONG INT a2;
+    LONG REAL a3 = LONG 1.9999999999; LONG REAL a4;
+    REAL a6;
+    INT a5; a5 := 30000;
+    a6 := 2/3;
+    tstli(398, +LONG 179, LENG 179);
+    tsti(399, +19, SHORTEN LONG 19);
+    tsti(400, +30000, SHORTEN LONG 30000);
+    tsti(401, -27, SHORTEN-LONG 27);
+    tsti(402, -30000, SHORTEN-LONG 30000);
+    tsti(403, +128, SHORTEN a1);
+    a2:=LONG 0;
+    tsti(404, +0, SHORTEN a2);
+    tsti(405, +30000, SHORTEN LENG a5);
+    tstr(406, +1.234566666e-1, SHORTEN LONG .1234566666);
+    tstr(407, +1.9999999999e+0, SHORTEN a3);
+    a4:=LONG .1111111111; tstr(408, +1.111111111e-1, SHORTEN a4);
+    tstr(409, -3.333333333333333e-1, SHORTEN-LENG (1/3));
+    tstr(410, +6.666666666666667e-1, SHORTEN LENG a6)
+END;
+
+puts("Test: ODD\n");
+BEGIN
+    IF ODD-1 THEN SKIP ELSE tste(411) FI;
+    tstb(412, FALSE, ODD 2);
+    IF NOT ODD-LONG 2 THEN SKIP ELSE tste(413) FI;
+    tstb(414, TRUE, ODD LONG 1);
+    BOOL a1, a2;
+    a1:= FALSE;
+    FOR i FROM -10 BY 1 TO 10
+    DO tstb(415, a1, ODD i); a1:= NOT a1 OD;
+    a1:=ODD-3;
+    a2:=ODD-LONG 0;
+    BOOL b1 = NOT ODD -13;
+    BOOL b2 = NOT NOT ODD -LONG 16;
+    tstb(416, TRUE, a1);
+    tstb(417, FALSE, a2);
+    tstb(418, FALSE, b1);
+    tstb(419, FALSE, b2);
+    tstb(420, FALSE, NOT NOT NOT ODD 55);
+    tstb(421, FALSE, NOT NOT NOT ODD LONG 1)
+END;
+
+puts("Test: SIGN\n");
+BEGIN
+    tsti(422, +1, SIGN 7);
+    tsti(423, +0, SIGN 0);
+    tsti(424, -1, SIGN-7);
+    tsti(425, +1, SIGN LONG 1000000000);
+    tsti(426, +0, SIGN LONG 0);
+    tsti(427, -1, SIGN-LONG 8);
+    tsti(428, +1, SIGN 1.9);
+    tsti(429, +0, SIGN 0.0);
+    tsti(430, -1, SIGN-3.6);
+    tsti(431, +1, SIGN LONG 67.0);
+    tsti(432, +0, SIGN LONG 0.0);
+    tsti(433, -1, SIGN-LONG 37.0)
+END;
+
+puts("Test: ROUND, ENTIER\n");
+BEGIN
+    REAL a1 = 1.7; LONG REAL a2 = LONG 27.7;
+    REAL a3; LONG REAL a4;
+    tstli(434, -LONG 28, LENG ROUND-27.7);
+    tstli(435, -LONG 28, LENG ENTIER-27.7);
+    tstli(436, +LONG 2, LENG ROUND a1);
+    tstli(437, +LONG 1, LENG ENTIER a1);
+    tstli(438, +LONG 13, LENG ROUND 12.9);
+    tstli(439, +LONG 12, LENG ENTIER 12.994);
+    a3:=134e+2; a4:=LONG 135.1e-1;
+    tstli(440, +LONG 13400, LENG ROUND a3);
+    tstli(441, +LONG 13400, LENG ENTIER a3);
+    tstli(442, +LONG 14, LENG ROUND SHORTEN a4);
+    tstli(443, +LONG 13, LENG ENTIER SHORTEN a4);
+    tstli(444, -LONG 1, ROUND-LENG 127e-2);
+    tstli(445, +LONG 1, ENTIER--LONG 127e-2);
+    tstli(446, +LONG 28, ROUND a2);
+    tstli(447, +LONG 27, ENTIER a2);
+    tstli(448, +LONG 13, ROUND LONG 12.87);
+    tstli(449, +LONG 12, ENTIER LONG 12.87);
+    tstli(450, +LONG 14, ROUND a4);
+    tstli(451, +LONG 13, ENTIER a4);
+    tstli(452, -LONG 2, ROUND-LONG 1.5001);
+    tstli(453, -LONG 2, ENTIER-LENG 1.5001);
+    tstli(454, +LONG 6, LENG ROUND 6.499)
+END;
+
+puts("Test: EQ, NE, LT, LE, GT, GE for chars\n");
+BEGIN
+    CHAR a = "1"; CHAR b = "2"; CHAR c; c := "1";
+    [1:1]CHAR d; d[1]:="$";
+    INT abs0 = ABS"0", abs1 = ABS"1", abs2 = ABS"2";
+
+    tstb(455, TRUE, "1"="1");
+    tstb(456, FALSE, "1"/="1");
+    tstb(457, TRUE, "1"<="1");
+    tstb(458, FALSE, "1"<"1");
+    tstb(459, TRUE, "1">="1");
+    tstb(460, FALSE, "1">"1");
+    tstb(461, FALSE, "1"="2");
+    tstb(462, TRUE, "1"/="2");
+    tstb(463, TRUE, "1"<="2");
+    tstb(464, TRUE, "1"<"2");
+    tstb(465, FALSE, "1">="2");
+    tstb(466, FALSE, "1">"2");
+    tstb(467, FALSE, "2"="1");
+    tstb(468, TRUE, "2"/="1");
+    tstb(469, FALSE, "2"<="1");
+    tstb(470, FALSE, "2"<"1");
+    tstb(471, TRUE, "2">="1");
+    tstb(472, TRUE, "2">"1");
+
+    tstb(473, TRUE, a=a);
+    tstb(474, FALSE, a/=a);
+    tstb(475, TRUE, a<=a);
+    tstb(476, FALSE, a<a);
+    tstb(477, TRUE, a>=a);
+    tstb(478, FALSE, a>a);
+    tstb(479, FALSE, a=b);
+    tstb(480, TRUE, a/=b);
+    tstb(481, TRUE, a<=b);
+    tstb(482, TRUE, a<b);
+    tstb(483, FALSE, a>=b);
+    tstb(484, FALSE, a>b);
+    tstb(485, FALSE, b=a);
+    tstb(486, TRUE, b/=a);
+    tstb(487, FALSE, b<=a);
+    tstb(488, FALSE, b<a);
+    tstb(489, TRUE, b>=a);
+    tstb(490, TRUE, b>a);
+
+    tstb(491, TRUE, REPR abs1=REPR abs1);
+    tstb(492, FALSE, REPR abs1/=REPR abs1);
+    tstb(493, TRUE, REPR abs1<=REPR abs1);
+    tstb(494, FALSE, REPR abs1<REPR abs1);
+    tstb(495, TRUE, REPR abs1>=REPR abs1);
+    tstb(496, FALSE, REPR abs1>REPR abs1);
+    tstb(497, FALSE, REPR abs1=REPR abs2);
+    tstb(498, TRUE, REPR abs1/=REPR abs2);
+    tstb(499, TRUE, REPR abs1<=REPR abs2);
+    tstb(500, TRUE, REPR abs1<REPR abs2);
+    tstb(501, FALSE, REPR abs1>=REPR abs2);
+    tstb(502, FALSE, REPR abs1>REPR abs2);
+    tstb(503, FALSE, REPR abs2=REPR abs1);
+    tstb(504, TRUE, REPR abs2/=REPR abs1);
+    tstb(505, FALSE, REPR abs2<=REPR abs1);
+    tstb(506, FALSE, REPR abs2<REPR abs1);
+    tstb(507, TRUE, REPR abs2>=REPR abs1);
+    tstb(508, TRUE, REPR abs2>REPR abs1);
+
+    tstb(509, TRUE, REPR abs1=c);
+    tstb(510, FALSE, REPR abs1/=c);
+    tstb(511, TRUE, REPR abs1<=c);
+    tstb(512, FALSE, REPR abs1<c);
+    tstb(513, TRUE, REPR abs1>=c);
+    tstb(514, FALSE, REPR abs1>c);
+    tstb(515, FALSE, REPR abs0=c);
+    tstb(516, TRUE, REPR abs0/=c);
+    tstb(517, TRUE, REPR abs0<=c);
+    tstb(518, TRUE, REPR abs0<c);
+    tstb(519, FALSE, REPR abs0>=c);
+    tstb(520, FALSE, REPR abs0>c);
+    tstb(521, FALSE, REPR abs2=c);
+    tstb(522, TRUE, REPR abs2/=c);
+    tstb(523, FALSE, REPR abs2<=c);
+    tstb(524, FALSE, REPR abs2<c);
+    tstb(525, TRUE, REPR abs2>=c);
+    tstb(526, TRUE, REPR abs2>c);
+
+    tstb(527, TRUE, c=REPR abs1);
+    tstb(528, FALSE, c/=REPR abs1);
+    tstb(529, TRUE, c<=REPR abs1);
+    tstb(530, FALSE, c<REPR abs1);
+    tstb(531, TRUE, c>=REPR abs1);
+    tstb(532, FALSE, c>REPR abs1);
+    tstb(533, FALSE, c=REPR abs0);
+    tstb(534, TRUE, c/=REPR abs0);
+    tstb(535, FALSE, c<=REPR abs0);
+    tstb(536, FALSE, c<REPR abs0);
+    tstb(537, TRUE, c>=REPR abs0);
+    tstb(538, TRUE, c>REPR abs0);
+    tstb(539, FALSE, c=REPR abs2);
+    tstb(540, TRUE, c/=REPR abs2);
+    tstb(541, TRUE, c<=REPR abs2);
+    tstb(542, TRUE, c<REPR abs2);
+    tstb(543, FALSE, c>=REPR abs2);
+    tstb(544, FALSE, c>REPR abs2);
+
+    tstb(545, TRUE, "$"=d[1]);
+    tstb(546, FALSE, "$"/=d[1]);
+    tstb(547, TRUE, "$"<=d[1]);
+    tstb(548, FALSE, "$"<d[1]);
+    tstb(549, TRUE, "$">=d[1]);
+    tstb(550, FALSE, "$">d[1]);
+    tstb(551, TRUE, "$"=d[1])
+END;
+   ASSERT (errors = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/simp01.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# ALGOL68 test to see if the compiler exists #
+BEGIN INT i, j, k;
+      INT s := 17, INT t := 3;
+      i := 0;
+      FOR l FROM 0 BY 2 TO 13 DO i +:= l OD;
+      ASSERT (i = 42)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/simp02.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+# Test that ranges are correct  #
+range_of_variables:
+BEGIN INT i, j;
+      i := 3; j := 4;
+      BEGIN INT i, k;
+            i := 2; k := 5;
+            ASSERT (i = 2);
+            ASSERT (k = 5)
+      END;
+      ASSERT (i = 3);
+      ASSERT (j = 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/simp03.a68
@@ -0,0 +1,12 @@
+# { dg-options "-fstropping=upper" }  #
+# Referencing and dereferencing.  #
+BEGIN INT i1 := 1;
+      INT i2 := 2;
+      INT i3 := 3;
+      INT ii1 := i1;
+      INT ii2 := i2;
+      REF INT iii1 := ii1;
+      ASSERT (iii1 = 1);
+      iii1 := ii2;
+      ASSERT (iii1 = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/simp04.a68
@@ -0,0 +1,46 @@
+# { dg-options "-fstropping=upper" }  #
+# Multiple values.  #
+multiples:
+structures:
+BEGIN [1:100]INT i, j, k;
+      FOR l TO 100 DO i[l] := j[l] := k[l] := l OD;
+      FOR l TO 100
+      DO IF i[l] /= l OR j[l] /= l OR k[l] /= l
+         THEN ASSERT (FALSE)
+         FI
+      OD;
+      [1:100]REAL p;
+      p[1] := 1.0;
+      p[1:5] := (2.0, 3.0, 4.0, 5.0, 6.0);
+      FOR i FROM 1 TO 5 DO ASSERT (p[i] = REAL(i) + 1.0) OD;
+      # Test the @ workings  #
+      p[2:6 # Implicit @1 #] := (2.0, 3.0, 4.0, 5.0, 6.0);
+      FOR i FROM 2 TO 6 DO ASSERT (p[i] = REAL(i)) OD;
+      p[2:3@8] := p[3:4@8];
+      ASSERT (UPB p[1:3@9] = 11 AND UPB p[1:0@5] = 4);
+      [1:10,1:10] INT l;
+      FOR i TO 10 DO FOR j TO 10 DO l[i,j] := 10 OD OD;
+      FOR i TO  2 DO FOR j TO 10 DO l[1:2,1:10][i,j] := 11 OD OD;
+      FOR i TO 10 DO FOR j TO 10
+                     DO IF i >= 1 AND i <= 2
+                        THEN ASSERT (l[i,j] = 11)
+                        ELSE ASSERT (l[i,j] = 10)
+                        FI
+                     OD
+      OD;
+      # Structures.  #
+      STRUCT ([1:2] INT m,
+              [1:i[5] # Whose value is 5 from above.  #]REAL g,
+              BOOL t) s1, s2;
+      t OF s1 := t OF s2 := l[1,1] = l[1:1,1:2][1,1];
+      ASSERT (t OF s1 AND t OF s2);
+      FOR m TO UPB m OF s1
+      DO (m OF s1)[m] := ((m OF s2)[3-m] := 50) + 1 OD;
+      g OF s1 := (g OF s2)[] := (1.0, 2.0, 3.0, 4.0, 5.0);
+      ASSERT ((m OF s1)[1] = 51 AND (m OF s1)[2] = 51);
+      # REF STRUCT's  #
+      [1:2]REF STRUCT ([]INT m, []REAL g, BOOL t) ss1 := (s1, s2);
+      t OF ss1[2] := FALSE;
+      ASSERT (t OF s1 = TRUE);
+      ASSERT (t OF s2 = FALSE)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/simp05.a68
@@ -0,0 +1,28 @@
+# { dg-options "-fstropping=upper" }  #
+# Simple jumps.  #
+(INT j:= 0, i;
+ k: i:= j;
+ IF i >= 2 THEN GOTO l FI;
+ puts ("0");
+ m: IF i >= 1 THEN n FI;
+ puts ("0");
+ o: GOTO p;
+ l: puts ("1"); i := i - 2; m;
+ n: puts ("1"); o;
+ p: puts ("");
+ j := j + 1;
+ IF j <= 3 THEN k FI)
+CO
+Result:
+  0
+  0
+
+  0
+  1
+
+  1
+  0
+
+  1
+  1
+CO
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/simp07.a68
@@ -0,0 +1,14 @@
+# { dg-options "-fstropping=upper" }  #
+# loops.  #
+BEGIN INT i = 5, INT c := 0;
+      FOR i TO i DO c +:= 1 OD;
+      ASSERT (c = 5);
+      INT s = 8;
+      FOR a FROM s BY 1 WHILE INT b = a - s + 1; a <= 2 * s
+      DO INT q := 0, r := a;
+         WHILE r >= b DO (q +:= 1, r -:=  b) OD;
+         IF a /= b * q +  r OR r >= b
+         THEN ASSERT (FALSE)
+         FI
+      OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/simp08.a68
@@ -0,0 +1,35 @@
+# { dg-options "-fstropping=upper" }  #
+# Simple coercions.  #
+BEGIN [1:3]INT ia := (1, 2, 3);
+      PROC get ia = REF[]INT: ia;
+      # Dereferencing.  #
+      INT i := LOC REF INT := ia[1]; # Twice dereferenced, at the right moment.  #
+      ASSERT (i = 1);
+      REF INT ri := ia[2]; # No deref  #
+      REF INT (ri) := -2;
+      ASSERT (ia[1] = 1 AND ia[2] = -2 AND ia[3] = 3);
+      # Deproceduring.  #
+      PROC pri = REF INT: ia[3]; pri := -3; # Soft deproc.  #
+      ASSERT (ia[1] = 1 AND ia[2] = -2 AND ia[3] = -3);
+      PROC pria = REF[]INT: ia; pria[1] := pria[2];
+      ASSERT (ia[1] = -2 AND ia[2] = -2 AND ia[3] = -3);
+      # Uniting.  #
+      UNION(REAL,[]INT,[,]INT) unia = # some uniting  #
+         UNION(REAL,[]INT) # cast  # # one uniting  # (ia); # deref  #
+      ia := (3,2,1); # spoil ia  #
+      CASE unia
+      IN ([]INT ia): (ASSERT (ia[1] = -2 AND ia[2] = -2 AND ia[3] = -3);
+                      ASSERT (get ia[1] = 3 AND get ia[2] = 2 AND get ia[3] = 1))
+      OUT SKIP
+      ESAC;
+      # Widening.  #
+      REAL x = ia[1];
+      ASSERT (x > 2.9 AND x < 3.1);
+      # Rowing.  #
+      [1:1,1:3] INT iaa; FOR i TO 3 DO iaa[1,i] := 5 + i OD;
+      # Hipping.  #
+      REF INT p = NIL, q = NIL;
+      ASSERT (p :=: q);
+      ia := (5, SKIP, 7); ia[2] := 6;
+      ASSERT (ia[1] = 5 AND ia[2] = 6 AND ia[3] = 7)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/simp09.a68
@@ -0,0 +1,17 @@
+# { dg-options "-fstropping=upper" }  #
+# In "situ" permutation  #
+BEGIN PROC permvec = (REF[]INT vec, []INT p) VOID:
+         FOR j TO UPB p
+         DO INT k := p[j];
+            WHILE k > j DO k := p[k] OD;
+            IF k = j
+            THEN INT h = vec[j], INT l := p[k];
+                 WHILE l NE j
+                 DO vec[k] := vec[l]; k := l; l := p[k] OD;
+                 vec[k] := h
+            FI
+         OD,
+      [1:5]INT x := (4, 5, 1, 3, 2);
+      permvec (x, (3,5,4,1,2));
+      ASSERT (x[1] = 1 AND x[2] = 2 AND x[3] = 3 AND x[4] = 4 AND x[5] = 5)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/simp10.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+(INT i := 1;
+    PROC a = (INT j) INT: i + j;
+    (INT i := 2; ASSERT (a(10) = 11)
+    )
+   )
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/simp11.a68
@@ -0,0 +1,36 @@
+# { dg-options "-fstropping=upper" }  #
+# Translation decimal number to Roman notation and vice versa  #
+BEGIN PROC roman = (INT number) STRING:
+      BEGIN INT n := number, STRING result;
+            []STRUCT(INT value, STRING r) table =
+               ((1000, "M"), (900, "CM"), (500, "D"), (400, "DC"),
+                (100, "C"), (90, "XC"), (50, "L"), (40, "XL"),
+                (10, "X"), (9, "IX"), (5, "V"), (4, "IV"), (1, "I"));
+            FOR i TO UPB table
+            DO INT v = value OF table[i], STRING r = r OF table[i];
+               WHILE v LE n DO (result +:= r, n -:= v) OD
+            OD;
+            result
+      END;
+
+      PROC value of roman = (STRING text) INT:
+      IF text = ""
+      THEN 0
+      ELSE OP ABS = (CHAR s) INT:
+              CASE INT p; char in string (s, p, "IVXLCDM"); p
+              IN 1, 5, 10, 50, 100, 500, 1000
+              ESAC,
+           PROC char in string = (CHAR c, REF INT i, STRING s) BOOL:
+              (FOR k TO UPB s DO (c = s[k] | i := k; l) OD; FALSE EXIT l: TRUE);
+           INT v, maxv := 0, maxp;
+           FOR p TO UPB text
+           DO IF (v := ABS text[p]) > maxv
+              THEN maxp := p; maxv := v
+              FI
+           OD;
+           maxv - value of roman (text[: maxp-1])+ value of roman (text[maxp + 1:])
+      FI;
+
+      ASSERT (roman (1968) = "MCMLXVIII");
+      ASSERT (value of roman ("MCMLXXIII") = 1973)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/simp13.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+# Continued fraction.  #
+BEGIN OP / = ([]REAL a, b) REAL:
+         (UPB a = 0 | 0 | a[1]/(b[1] + a[2:]/b[2:])),
+      [1:20]REAL x,y;
+
+      FOR i TO 20
+      DO x[i] := (i-1)**2; y[i] := 2*i-1 OD;
+      x[1] := 1;
+      FOR i TO 20
+      DO 4 * (x[1:i]/y[1:i]) # Approximations of PI  #
+      OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/stow02.a68
@@ -0,0 +1,15 @@
+# { dg-options "-fstropping=upper" }  #
+# Some slices #
+BEGIN [0:7][0:15] INT a;
+      INT n:= 0;
+
+      FOR i TO 8 DO FOR j TO 16 DO a[i-1][j-1]:= n+:=1OD OD;
+      ASSERT (a[0][15] = 16);
+      ASSERT (a[0:0 AT 0][0][15] = 16);
+      ASSERT (a[0:0 AT 0][0:0 AT 0][0][3:15][11:13 AT 2][4] = 16);
+CO XXX run-time error
+      []INT k = a[0:0][15] # wrong, a[0:0] has bounds [1:1][0:15],
+                             so there occurs overflow #;
+CO
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mcts/stow06.a68
@@ -0,0 +1,30 @@
+# { dg-options "-fstropping=upper" }  #
+# Against over-optimization of string comparison.  #
+BEGIN
+    STRING newline = "'n";
+    STRING str = "string with step > 1"; STRING ref str:= str;
+    [1:UPB str] STRUCT(REAL flub, CHAR c) rst;
+
+    puts ("Result must be:"
+           + newline + str + "." + newline + str + "." + newline
+           + "First test OK" + newline + "Second test OK" + newline
+           + newline + "Result is:" + newline);
+
+    FOR i TO UPB str DO c OF rst[i]:= ref str[i] OD;
+    puts (c OF rst +  "." + newline + ref str + "." + newline);
+
+    IF c OF rst = str AND c OF rst = ref str
+    THEN puts ("First test OK" + newline)
+    ELSE puts ("Erroneous string, is: " + c OF rst
+               + " , must be: " + str + newline);
+         ASSERT (FALSE)
+    FI;
+
+    c OF rst:= str;
+    IF c OF rst /= str OR c OF rst /= ref str
+    THEN puts ("Erroneous string, is: " + c OF rst
+               + " , must be: " + str + newline);
+         ASSERT (FALSE)
+    ELSE puts ("Second test OK" + newline)
+    FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/minus-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 10;
+      LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+      SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10;
+      ASSERT (i - 2 = 8);
+      ASSERT (ii - LONG 2 = LONG 8);
+      ASSERT (iii - LONG LONG 2 = LONG LONG 8);
+      ASSERT (ss - SHORT 2 = SHORT 8);
+      ASSERT (sss - SHORT SHORT 2 = SHORT SHORT 8)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/minusab-1.a68
@@ -0,0 +1,32 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN BEGIN INT i := 10;
+            i -:= 2;
+            ASSERT (i = 8);
+            i MINUSAB 2;
+            ASSERT (i = 6)
+      END;
+      BEGIN LONG INT i := LONG 1000;
+            i -:= LONG 100;
+            ASSERT (i = LONG 900);
+            i MINUSAB LONG 100;
+            ASSERT (i = LONG 800)
+      END;
+      BEGIN LONG LONG INT i := LONG LONG 10000;
+            i -:= LONG LONG 1000;
+            ASSERT (i = LONG LONG 9000);
+            i MINUSAB LONG LONG 1000;
+            ASSERT (i = LONG LONG 8000)
+      END;
+      BEGIN SHORT INT i := SHORT 100;
+            i -:= SHORT 10;
+            ASSERT (i = SHORT 90);
+            i MINUSAB SHORT 10;
+            ASSERT (i = SHORT 80)
+      END;
+      BEGIN SHORT SHORT INT i := SHORT SHORT 10;
+            i -:= SHORT SHORT 1;
+            ASSERT (i = SHORT SHORT 9);
+            i MINUSAB SHORT SHORT 2;
+            ASSERT (i = SHORT SHORT 7)
+      END
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/minusab-2.a68
@@ -0,0 +1,20 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN BEGIN REAL i := 10.0;
+            i -:= 2.0;
+            ASSERT (i = 8.0);
+            i MINUSAB 2.0;
+            ASSERT (i = 6.0)
+      END;
+      BEGIN LONG REAL i := LONG 1000.0;
+            i -:= LONG 100.0;
+            ASSERT (i = LONG 900.0);
+            i MINUSAB LONG 100.0;
+            ASSERT (i = LONG 800.0)
+      END;
+      BEGIN LONG LONG REAL i := LONG LONG 10000.0;
+            i -:= LONG LONG 1000.0;
+            ASSERT (i = LONG LONG 9000.0);
+            i MINUSAB LONG LONG 1000.0;
+            ASSERT (i = LONG LONG 8000.0)
+      END
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/minusab-3.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n := 10;
+      (((n -:= 1))) := 5;
+      ASSERT (n = 5)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/minusab-4.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT num ints := 10;
+      num ints -:= 1;
+      ASSERT (num ints = 9);
+      ASSERT ((LOC INT -:= 12) = -12)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mod-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 10;
+      LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+      SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10;
+      ASSERT (i %* 3 = 1);
+      ASSERT (ii %* LONG 3 = LONG 1);
+      ASSERT (iii %* LONG LONG 3 = LONG LONG 1);
+      ASSERT (ss %* SHORT 3 = SHORT 1);
+      ASSERT (sss MOD SHORT SHORT 3 = SHORT SHORT 1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/modab-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN (SHORT SHORT INT i := SHORT SHORT 11; i MODAB SHORT SHORT 2; ASSERT (i = SHORT SHORT 1));
+      (SHORT INT i := SHORT 11; i MODAB SHORT 2; ASSERT (i = SHORT 1));
+      (INT i := 11; i MODAB 2; ASSERT (i = 1));
+      (INT i := 11; i %*:= 2; ASSERT (i = 1));
+      (LONG INT i := LONG 11; i MODAB LONG 2; ASSERT (i = LONG 1));
+      (LONG INT i := LONG 11; i %*:= LONG 2; ASSERT (i = LONG 1));
+      (LONG LONG INT i := LONG LONG 11; i MODAB LONG LONG 2; ASSERT (i = LONG LONG 1));
+      (LONG LONG INT i := LONG LONG 11; i %*:= LONG LONG 2; ASSERT (i = LONG LONG 1))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/modab-2.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n := 10;
+      (((n MODAB 1))) := 5;
+      ASSERT (n = 5)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mode-indication-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT j; REAL y;
+      MODE R = REAL;
+      BEGIN MODE R = INT;
+            R i := j;
+            SKIP
+      END;
+      R x := y;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mult-char-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT ("a" * 3 = "aaa");
+      ASSERT ("" * 1 = "");
+      ASSERT ("x" * 0 = "x")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mult-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 10;
+      LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+      SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10;
+      ASSERT (i * 2 = 20);
+      ASSERT (ii * LONG 2 = LONG 20);
+      ASSERT (iii * LONG LONG 2 = LONG LONG 20);
+      ASSERT (ss * SHORT 2 = SHORT 20);
+      ASSERT (sss * SHORT SHORT 2 = SHORT SHORT 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mult-string-1.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRING foo = "foo";
+      ASSERT (foo * -10 = "foo");
+      ASSERT (-10 * foo = "foo");
+      ASSERT (foo * 0 = "foo");
+      ASSERT (0 * foo = "foo");
+      ASSERT (foo * 1 = "foo");
+      ASSERT (1 * foo = "foo");
+      ASSERT (foo * 2 = "foofoo");
+      ASSERT (2 * foo = "foofoo");
+      ASSERT (foo * 3 = "foofoofoo");
+      ASSERT (3 * foo = "foofoofoo")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mult-string-2.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []CHAR foo = ("f","o","o");
+      ASSERT (foo * -10 = "foo");
+      ASSERT (-10 * foo = "foo");
+      ASSERT (foo * 0 = "foo");
+      ASSERT (0 * foo = "foo");
+      ASSERT (foo * 1 = "foo");
+      ASSERT (1 * foo = "foo");
+      ASSERT (foo * 2 = "foofoo");
+      ASSERT (2 * foo = "foofoo");
+      ASSERT (foo * 3 = "foofoofoo");
+      ASSERT (3 * foo = "foofoofoo")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mult-string-3.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN FLEX[3]CHAR foo := ("f","o","o");
+      ASSERT (foo * -10 = "foo");
+      ASSERT (-10 * foo = "foo");
+      ASSERT (foo * 0 = "foo");
+      ASSERT (0 * foo = "foo");
+      ASSERT (foo * 1 = "foo");
+      ASSERT (1 * foo = "foo");
+      ASSERT (foo * 2 = "foofoo");
+      ASSERT (2 * foo = "foofoo");
+      ASSERT (foo * 3 = "foofoofoo");
+      ASSERT (3 * foo = "foofoofoo")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mult-string-4.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRING foo = "abc";
+      ASSERT (foo[] * 2 = "abcabc")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/multab-1.a68
@@ -0,0 +1,31 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 2;
+      i *:= 2;
+      ASSERT (i = 4);
+      i *:= 2;
+      ASSERT (i = 8);
+
+      SHORT INT s := SHORT 2;
+      s *:= SHORT 2;
+      ASSERT (s = SHORT 4);
+      s *:= SHORT 3;
+      ASSERT (s = SHORT 12);
+
+      SHORT SHORT INT ss := SHORT SHORT 2;
+      ss *:= SHORT SHORT 2;
+      ASSERT (ss = SHORT SHORT 4);
+      ss *:= SHORT SHORT 3;
+      ASSERT (ss = SHORT SHORT 12);
+
+      REF LONG INT ii = HEAP LONG INT := LONG 2;
+      ii *:= LONG 2;
+      ASSERT (ii = LONG 4);
+      ii *:= LONG 2;
+      ASSERT (ii = LONG 8);
+
+      LONG LONG INT iii := LONG LONG 2;
+      iii *:= LONG LONG 2;
+      ASSERT (iii = LONG LONG 4);
+      iii *:= LONG LONG 2;
+      ASSERT (iii = LONG LONG 8)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/multab-2.a68
@@ -0,0 +1,31 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 2;
+      i TIMESAB 2;
+      ASSERT (i = 4);
+      i TIMESAB 2;
+      ASSERT (i = 8);
+
+      REF SHORT INT ss = HEAP SHORT INT := SHORT 2;
+      ss TIMESAB SHORT 2;
+      ASSERT (ss = SHORT 4);
+      ss TIMESAB SHORT 2;
+      ASSERT (ss = SHORT 8);
+
+      SHORT SHORT INT sss := SHORT SHORT 2;
+      sss TIMESAB SHORT SHORT 2;
+      ASSERT (sss = SHORT SHORT 4);
+      sss TIMESAB SHORT SHORT 2;
+      ASSERT (sss = SHORT SHORT 8);
+      
+      REF LONG INT ii = HEAP LONG INT := LONG 2;
+      ii TIMESAB LONG 2;
+      ASSERT (ii = LONG 4);
+      ii TIMESAB LONG 2;
+      ASSERT (ii = LONG 8);
+
+      LONG LONG INT iii := LONG LONG 2;
+      iii TIMESAB LONG LONG 2;
+      ASSERT (iii = LONG LONG 4);
+      iii TIMESAB LONG LONG 2;
+      ASSERT (iii = LONG LONG 8)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/multab-3.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT num ints := 10;
+      num ints *:= 2;
+      ASSERT (num ints = 20);
+      ASSERT ((LOC INT *:= 12) = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/mutual-recursion-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC is even = (INT n) BOOL: (n = 0 | TRUE | is odd (n - 1));
+      PROC is odd = (INT n) BOOL: (n = 0 | FALSE | is even (n - 1));
+      ASSERT (is even (20));
+      ASSERT (is odd (13))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/ne-bits-1.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN BITS b, LONG BITS bb = LONG 16rff,  LONG LONG BITS bbb;
+      SHORT BITS ss = SHORT 16rff, SHORT SHORT BITS sss;
+      ASSERT (b /= 2r1);
+      ASSERT (bb NE LONG 8r477);
+      ASSERT (bbb /= LONG LONG 8r2);
+      ASSERT (ss NE SHORT 8r477);
+      ASSERT (sss /= SHORT SHORT 8r2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/ne-char-char-1.a68
@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT ("x" /= "a")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/ne-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 12;
+      LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12;
+      SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12;
+      ASSERT (13 /= i);
+      ASSERT (ii NE LONG 13);
+      ASSERT (iii /= LONG LONG 13);
+      ASSERT (s /= SHORT 13);
+      ASSERT (ss /= SHORT SHORT 13)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/ne-string-1.a68
@@ -0,0 +1,15 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRING foo = "foo", bar = "bar", quux = "quux";
+      # /=  #
+      ASSERT (NOT ("" /= ""));
+      ASSERT (NOT ("foo" /= foo));
+      ASSERT (foo /= bar);
+      ASSERT (foo /= quux);
+      ASSERT (quux /= foo);
+      # NE  #
+      ASSERT (NOT ("" NE ""));
+      ASSERT (NOT ("foo" NE foo));
+      ASSERT (foo NE bar);
+      ASSERT (foo NE quux);
+      ASSERT (quux NE foo)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/neg-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 10;
+      LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+      SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10;
+      ASSERT (-i = -10);
+      ASSERT (-ii  = - LONG 10);
+      ASSERT (-iii = - LONG LONG 10);
+      ASSERT (-ss  = - SHORT 10);
+      ASSERT (-sss = - SHORT SHORT 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/not-bits-1.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+# NOT for SIZETY BITS.  #
+BEGIN BITS b = 16rf0f0;
+      ASSERT ((NOT b AND 16rffff) = 16r0f0f);
+      LONG BITS bb = LONG 16rf0f0;
+      ASSERT ((NOT bb AND LONG 16rffff) = LONG 16r0f0f);
+      LONG LONG BITS bbb = LONG LONG 16rf0f0;
+      ASSERT ((NOT bbb AND LONG LONG 16rffff) = LONG LONG 16r0f0f);
+      SHORT BITS ss = SHORT 16rf0f0;
+      ASSERT ((NOT ss AND SHORT 16rffff) = SHORT 16r0f0f);
+      SHORT SHORT BITS sss = SHORT SHORT 16rf0f0;
+      ASSERT ((NOT sss AND SHORT SHORT 16rffff) = SHORT SHORT 16r0f0f)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/odd-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT a = 1;
+      ASSERT (ODD a);
+      ASSERT (ODD LONG 3);
+      ASSERT (NOT ODD LONG LONG 4);
+      ASSERT (ODD SHORT 3);
+      ASSERT (NOT ODD SHORT SHORT 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/op-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN OP ONEOVER = (REAL a) REAL: 1/a;
+      REAL x;
+      x := ONEOVER 3.14
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/op-2.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN OP + = (INT a, b) INT: a - -b;
+      ASSERT (10 + 30 = 40)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/op-3.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN OP MIN = (REAL a, b) REAL: (a < b | a | b),
+         MIN = (INT a, REAL b) REAL: (a < b | a | b),
+         MIN = (REAL a, INT b) REAL: a MIN REAL (b);
+      PRIO MIN = 6;
+      ASSERT (10.0 MIN 20.0 > 9.9 AND 10.0 MIN 20.0 < 10.1);
+      ASSERT (10.0 MIN 100 > 9.9 AND 10.0 MIN 100 < 10.1);
+      ASSERT (100.0 MIN 10 > 9.9 AND 100.0 MIN 10 < 10.1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/operator-declaration-1.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n = 10;
+      # Note that the priority for the monadic operators gets ignored.  #
+      PRIO JORL = 6, JURL = 6, XXX = 6, YYY = 6;
+      OP(INT)INT JORL = (n > 10 | (INT a) INT: a + 1 | (INT a) INT: a - 1),
+                 JURL = (n <= 10 | (INT a) INT: a + 1 | (INT a) INT: a - 1);
+      OP(INT,INT)INT XXX = (INT a, b) INT: a + b,
+                     YYY = (n > 10 | (INT a,b) INT: a * b | (INT a,b) INT: a - b);
+      ASSERT (JORL 10 = 9);
+      ASSERT (JURL 10 = 11);
+      ASSERT (2 XXX 3 = 5);
+      ASSERT (2 YYY 3 = -1);
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/or-bits-1.a68
@@ -0,0 +1,18 @@
+# { dg-options "-fstropping=upper" }  #
+# OR for SIZETY BITS.  #
+BEGIN BITS b = 16rf0f0;
+      ASSERT ((b OR 16r0f0f) = 16rffff);
+      ASSERT ((b OR 16r00ff) = 16rf0ff);
+      LONG BITS bb = LONG 16rf0f0;
+      ASSERT ((bb OR LONG 16r0f0f) = LONG 16rffff);
+      ASSERT ((bb OR LONG 16r00ff) = LONG 16rf0ff);
+      LONG LONG BITS bbb = LONG LONG 16rf0f0;
+      ASSERT ((bbb OR LONG LONG 16r0f0f) = LONG LONG 16rffff);
+      ASSERT ((bbb OR LONG LONG 16r00ff) = LONG LONG 16rf0ff);
+      SHORT BITS ss = SHORT 16rf0f0;
+      ASSERT ((ss OR SHORT 16r0f0f) = SHORT 16rffff);
+      ASSERT ((ss OR SHORT 16r00ff) = SHORT 16rf0ff);
+      SHORT SHORT BITS sss = SHORT SHORT 16rf0f0;
+      ASSERT ((sss OR SHORT SHORT 16r0f0f) = SHORT SHORT 16rffff);
+      ASSERT ((sss OR SHORT SHORT 16r00ff) = SHORT SHORT 16rf0ff)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/orf-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 10;
+      ASSERT (i = 0 OREL i = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/over-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 10;
+      LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+      SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10;
+      ASSERT (i % 2 = 5);
+      ASSERT (ii % LONG 2 = LONG 5);
+      ASSERT (iii % LONG LONG 2 = LONG LONG 5);
+      ASSERT (ss % SHORT 2 = SHORT 5);
+      ASSERT (sss % SHORT SHORT 2 = SHORT SHORT 5)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/overab-1.a68
@@ -0,0 +1,12 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN (INT i := 11; i OVERAB 2; ASSERT (i = 5));
+      (INT i := 11; i %:= 2; ASSERT (i = 5));
+      (SHORT INT i := SHORT 11; i OVERAB SHORT 2; ASSERT (i = SHORT 5));
+      (SHORT INT i := SHORT 11; i %:= SHORT 2; ASSERT (i = SHORT 5));
+      (SHORT SHORT INT i := SHORT SHORT 11; i OVERAB SHORT SHORT 2; ASSERT (i = SHORT SHORT 5));
+      (SHORT SHORT INT i := SHORT SHORT 11; i %:= SHORT SHORT 2; ASSERT (i = SHORT SHORT 5));
+      (LONG INT i := LONG 11; i OVERAB LONG 2; ASSERT (i = LONG 5));
+      (LONG INT i := LONG 11; i %:= LONG 2; ASSERT (i = LONG 5));
+      (LONG LONG INT i := LONG LONG 11; i OVERAB LONG LONG 2; ASSERT (i = LONG LONG 5));
+      (LONG LONG INT i := LONG LONG 11; i %:= LONG LONG 2; ASSERT (i = LONG LONG 5))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/overab-2.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n := 10;
+      (((n OVERAB 1))) := 5;
+      ASSERT (n = 5)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/particular-program-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+# Particular program with preceding labels.  #
+jo: ju:
+BEGIN SKIP END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/plus-char-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT ("a" + "b" = "ab");
+      ASSERT ("" + "x" = "x")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/plus-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 10;
+      LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10;
+      SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10;
+      ASSERT (i + 2 = 12);
+      ASSERT (ii + LONG 2 = LONG 12);
+      ASSERT (iii + LONG LONG 2 = LONG LONG 12);
+      ASSERT (ss + SHORT 2 = SHORT 12);
+      ASSERT (sss + SHORT SHORT 2 = SHORT SHORT 12)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/plus-string-1.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRING foo = "foo", bar = "bar", quux = "quux";
+      ASSERT ("" + "" = "");
+      ASSERT ("" + foo = "foo");
+      ASSERT (bar + "" = "bar");
+      ASSERT (foo + bar = "foobar");
+      STRING res = foo + bar;
+      ASSERT (LWB res = 1 AND UPB res = 6);
+      STRING empty = "" + "";
+      ASSERT (LWB empty = 1 AND UPB empty = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/plus-string-2.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC rec parse comment = VOID:
+      BEGIN STRING content;
+            done;
+            100;
+      done:
+            ASSERT (content + "x" = "x")
+      END;
+
+      rec parse comment
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/plus-string-stride-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]CHAR matrix = (("1","H","3"),
+                        ("4","O","6"),
+                        ("7","M","9"),
+                        ("8","E","2"));
+      ASSERT (matrix[1:2,1] + matrix[3:4,3] = "1492")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/plusab-1.a68
@@ -0,0 +1,34 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN BEGIN INT i := 10;
+            i +:= 2;
+            ASSERT (i = 12);
+            i PLUSAB 2;
+            ASSERT (i = 14)
+      END;
+
+      BEGIN SHORT INT i := SHORT 1000;
+            i +:= SHORT 100;
+            ASSERT (i = SHORT 1100);
+            i PLUSAB SHORT 100;
+            ASSERT (i = SHORT 1200)
+      END;
+      BEGIN SHORT SHORT INT i := SHORT SHORT 10000;
+            i +:= SHORT SHORT 1000;
+            ASSERT (i = SHORT SHORT 11000);
+            i PLUSAB SHORT SHORT 1000;
+            ASSERT (i = SHORT SHORT 12000)
+      END;
+
+      BEGIN LONG INT i := LONG 1000;
+            i +:= LONG 100;
+            ASSERT (i = LONG 1100);
+            i PLUSAB LONG 100;
+            ASSERT (i = LONG 1200)
+      END;
+      BEGIN LONG LONG INT i := LONG LONG 10000;
+            i +:= LONG LONG 1000;
+            ASSERT (i = LONG LONG 11000);
+            i PLUSAB LONG LONG 1000;
+            ASSERT (i = LONG LONG 12000)
+      END
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/plusab-2.a68
@@ -0,0 +1,20 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN BEGIN REAL i := 10.0;
+            i +:= 2.0;
+            ASSERT (i > 11.9);
+            i PLUSAB 2.0;
+            ASSERT (i > 13.9)
+      END;
+      BEGIN LONG REAL i := LONG 1000.0;
+            i +:= LONG 100.0;
+            ASSERT (i > LONG 1099.9);
+            i PLUSAB LONG 100.0;
+            ASSERT (i > LONG 1199.9)
+      END;
+      BEGIN LONG LONG REAL i := LONG LONG 10000.0;
+            i +:= LONG LONG 1000.0;
+            ASSERT (i > LONG LONG 10999.9);
+            i PLUSAB LONG LONG 1000.0;
+            ASSERT (i > LONG LONG 11999.9)
+      END
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/plusab-3.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n := 0;
+      (((n +:= 1))) := 5;
+      ASSERT (n = 5)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/plusab-4.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT num ints := 0;
+      num ints +:= 1;
+      ASSERT (num ints = 1);
+      ASSERT ((LOC INT +:= 12) = 12)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/plusab-string-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRING foo := "";
+      foo +:= "foo";
+      ASSERT (LWB foo = 1 AND UPB foo = 3 AND foo = "foo");
+      foo PLUSAB "bar";
+      ASSERT (LWB foo = 1 AND UPB foo = 6 AND foo = "foobar")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/plusto-char-1.a68
@@ -0,0 +1,7 @@
+begin string foo := "foo";
+      char c := "x";
+      c PLUSTO foo;
+      assert (foo = "xfoo");
+      c +=: foo;
+      assert (foo = "xxfoo")
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/plusto-string-1.a68
@@ -0,0 +1,6 @@
+begin string foo := "foo";
+      "bar" PLUSTO foo;
+      assert (foo = "barfoo");
+      "quux" +=: foo;
+      assert (foo = "quuxbarfoo")
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/posix-argc-argv-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (argc >= 1);
+      ASSERT (argv (1000) = "");
+      ASSERT (argv (-1) = "");
+      FOR i TO argc
+      DO puts (argv (i)) OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/posix-fopen-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT fd = fopen ("doesn''t exist", file o default);
+      ASSERT (fd = -1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/posix-fputc-fputs-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN fputc (stdout, "X");
+      ASSERT (fputs (stdout, "foo") = 3);
+      fputs (stdout, fputc (stdout, "Y") + "T");
+      fputc (stdout, "Z");
+      ASSERT (fputs (stdout, "") = 0);
+      puts ("")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/posix-getenv-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (getenv ("") = "");
+      ASSERT (getenv ("DOESNT EXIST FOR SURE") = "")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/posix-perror-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# { dg-output "^something unique: " }  #
+BEGIN INT fd = fopen ("doesn''t exist", file o default);
+      IF fd = -1 THEN
+         ASSERT (strerror (errno) /= "");
+         perror ("something unique")
+      FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/posix-putchar-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN putchar ("X");
+      putchar ("Y");
+      putchar ("Z");
+      puts ("\n")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/posix-stdinouterr-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (stdin = 0);
+      ASSERT (stdout = 1);
+      ASSERT (stderr = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/posix-strerror-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT fd = fopen ("doesn''t exist", file o default);
+      IF fd = -1 THEN ASSERT (strerror (errno) /= "") FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/posix-stride-1.a68
@@ -0,0 +1,14 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]CHAR matrix = (("1","H","3"),
+                        ("4","O","6"),
+                        ("7","M","9"),
+                        ("8","E","0"));
+      []CHAR column = matrix[1:4,2];
+      puts (column);
+      fputs (stdout, matrix[3,2:3]);
+      puts ("\n");
+      fputs (stdout, matrix[1:3,1]);
+      puts ("\n");
+      puts (getenv (matrix[,2]));
+      perror (matrix[,3])
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/pow-int-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 2;
+      LONG INT ii = LONG 2, LONG LONG INT iii = LONG LONG 2;
+      SHORT INT ss = SHORT 2, SHORT SHORT INT sss = SHORT SHORT 2;
+      ASSERT (i ** 2 = 4);
+      ASSERT (ii ** 2 = LONG 4);
+      ASSERT (iii ** 2 = LONG LONG 4);
+      ASSERT (ss ** 2 = SHORT 4);
+      ASSERT (sss ** 2 = SHORT SHORT 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/pow-real-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL r0 = 2.0; LONG REAL rr0 = LONG 2.0; LONG LONG REAL rrr0 = LONG LONG 2.0;
+      REAL r1 = r0 ^ 2; REAL r2 = r0 ^ 3.0;
+      LONG REAL rr1 = rr0 ^ LONG 2; LONG REAL rr2 = rr0 ^ LONG 3.0;
+      LONG LONG REAL rrr1 = rrr0 ^ LONG LONG 2; LONG LONG REAL rrr2 = rrr0 ^ LONG LONG 3.0;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC foo = INT: 100;
+      ASSERT (foo = 100)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-10.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC(INT,INT)INT foo = (INT i, j) INT: i + j;
+      ASSERT (foo (10, 20) = 30)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-12.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC(INT)INT foo = baz;
+      PROC bar = (INT i) INT: i + 1;
+      PROC baz = (INT i) INT: i - 1;
+      ASSERT (foo (10) = 9)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-13.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC is even := (INT n) BOOL: n %* 2 = 0;
+      ASSERT (is even (40));
+      PROC no args := BOOL: TRUE;
+      ASSERT (no args)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-14.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC is even := (INT n) BOOL: n %* 2 = 0;
+      PROC is odd := (INT n) BOOL: n %* 2 /= 0;
+      PROC(INT)BOOL f = is even;
+      PROC(INT)BOOL g = is odd;
+      ASSERT (f (40));
+      ASSERT (g (3))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-15.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# Nested procedures.  #
+BEGIN PROC foo = (INT i) INT:
+      BEGIN PROC bar = (INT i) INT: i - 1;
+            bar (i) * 10
+      END;
+      ASSERT (foo (10) = 90)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-16.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC bar = (INT i) INT: i - 1;
+      PROC foo = (INT i) INT:
+      BEGIN
+            bar (i) * 10
+      END;
+      ASSERT (foo (10) = 90)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-17.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+# Identity declarations and procedures.  #
+BEGIN PROC foo = (INT i) INT: i + 1;
+      ASSERT (foo (10) = 11);
+      PROC(INT)INT bar = (INT i) INT: i + 1;
+      ASSERT (bar (10) = 11);
+      PROC(INT)INT baz = foo;
+      ASSERT (baz (10) = 11);
+      PROC(INT)INT quux = IF 10 > 1 THEN baz ELSE foo FI;
+      ASSERT (quux (10) = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-18.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC foo = (INT i) INT: i + 1;
+      PROC(INT)INT bar;
+      bar := foo;
+      ASSERT (bar (10) = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-19.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC foo = (INT i) INT: i + 1;
+      PROC(INT)INT bar := foo;
+      ASSERT (bar (10) = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Call a non-variable procedure before declaration.  #
+BEGIN ASSERT (foo = 100);
+      PROC foo = INT: 100;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-20.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC foo := (INT i) INT: i + 1;
+      PROC(INT)INT bar := foo;
+      ASSERT (bar (10) = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-21.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# REF REF PROC  #
+BEGIN PROC foo = (INT i) INT: i + 1;
+      PROC(INT)INT bar := foo;
+      REF PROC(INT)INT baz;
+      baz := bar;
+      ASSERT (baz (10) = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-22.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# REF REF PROC  #
+BEGIN PROC foo = (INT i) INT: i + 1;
+      PROC(INT)INT bar := foo;
+      REF PROC(INT)INT baz := bar;
+      ASSERT (baz (10) = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-23.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC increment = (INT a) INT: a + 1;
+      PROC getproc = PROC(INT)INT:
+      BEGIN increment
+      END;
+      # getproc below gets deprocedured to yield increment.  #
+      ASSERT (getproc (10) = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-25.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC increment := (INT a) INT: a + 1;
+      PROC getproc := PROC(INT)INT:
+      BEGIN increment
+      END;
+      # getproc below gets deprocedured to yield increment.  #
+      ASSERT (getproc (10) = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-26.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC sum = (INT a, b) INT: a + b,
+           minus = (INT a, b) INT: a - b;
+      ASSERT (sum (1, 2) = 3);
+      ASSERT (minus (1, 2) = -1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-27.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC reciprocal = (REAL a) REAL: 1/a;
+      REAL x;
+      x := reciprocal (3.14)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-28.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC hcf = (INT m, n) INT:
+         IF m < n
+         THEN hcf (n, m)
+         ELIF n = 0
+         THEN m
+         ELSE hcf (n, m MOD n)
+         FI;
+      ASSERT (hcf (10, 20) = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-29.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# A heap proc variable.  #
+BEGIN HEAP PROC foo := INT: 666;
+      ASSERT (foo = 666)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-3.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC foo = (INT i, j) INT: i + j + 1;
+      ASSERT (foo (10, 11) = 22)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-4.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (foo (10, 11) = 22);
+      PROC foo = (INT i, j) INT: i + j + 1;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-5.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Recursive function.  #
+BEGIN PROC foo = (INT i) INT: (i > 0 | i + foo (i - 1) | 0);
+      ASSERT (foo (10) = 55)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-6.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Recursive function, used before declared.  #
+BEGIN ASSERT (foo (10) = 55);
+      PROC foo = (INT i) INT: BEGIN (i > 0 | i + foo (i - 1) | 0) END;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-7.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC foo = (INT i) INT: i + 1;
+      PROC(INT)INT bar = foo;
+      ASSERT (bar (10) = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/proc-8.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC INT foo = INT: 100;
+      ASSERT (foo = 100)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/procedured-goto-1.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 4;
+beg:  WHILE i > 0
+      DO []PROC VOID table = (l3,l1,l2,end);
+         table[i];
+l1:      puts ("uno\n"); i -:= 1; beg;
+l2:      puts ("dos\n"); i -:= 1; beg;
+l3:      puts ("tres\n"); i -:= 1; beg;
+end:     puts ("cuatro\n"); i -:= 1; beg
+      OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/quine.a68
@@ -0,0 +1,2 @@
+# { dg-options "-fstropping=upper" }  #
+(STRING a="(STRING a="";puts(2*a[:19]+2*a[19:]);0)";puts(2*a[:19]+2*a[19:]))
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/random-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN IF random > 0.5 THEN puts ("yes\n") ELSE puts ("no\n") FI;
+      LONG REAL rr = long random;
+      IF rr > LONG 0.5 THEN puts ("long yes\n") ELSE puts ("long no\n") FI;
+      LONG LONG REAL rrr = long long random;
+      IF rrr > LONG LONG 0.5 THEN puts ("long long yes\n") ELSE puts ("long long no\n") FI
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/re-im-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN COMPL z = 4.0I5.0;
+      ASSERT (RE z = 4.0 AND IM z = 5.0);
+      LONG COMPL zz = LONG 4.0 I LONG 6.0;
+      ASSERT (RE zz = LONG 4.0 AND IM zz = LONG 6.0);
+      LONG LONG COMPL zzz = LONG LONG 4.0 I LONG LONG 7.0;
+      ASSERT (RE zzz = LONG LONG 4.0 AND IM zzz = LONG LONG 7.0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rela-string-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT ("" >= "");
+      ASSERT ("" <= "");
+      ASSERT ("zzz" > "aaa");
+      ASSERT ("zzz" >= "aaa");
+      ASSERT ("HelloA" < "HelloB")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/repr-1.a68
@@ -0,0 +1,3 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (REPR ABS "x" = "x")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/round-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL x = 3.14, y = 3.80;
+      LONG REAL xx = LONG 3.14, yy = LONG 3.80;
+      LONG LONG REAL xxx = LONG LONG 3.14, yyy = LONG LONG 3.80;
+      ASSERT (ROUND x = 3 AND ROUND y = 4);
+      ASSERT (ROUND xx = LONG 3 AND ROUND yy = LONG 4);
+      ASSERT (ROUND xxx = LONG LONG 3 AND ROUND yyy = LONG LONG 4)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/row-display-1.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT foo = (7,8,9);
+      [,]INT bar = ((1,2,3),(4,5,6),foo);
+      ASSERT (bar[1,1] = 1);
+      ASSERT (bar[1,2] = 2);
+      ASSERT (bar[1,3] = 3);
+      ASSERT (bar[2,1] = 4);
+      ASSERT (bar[2,2] = 5);
+      ASSERT (bar[2,3] = 6);
+      ASSERT (bar[3,1] = 7);
+      ASSERT (bar[3,2] = 8);
+      ASSERT (bar[3,3] = 9)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/row-display-2.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT foo = (7,8,9);
+      [3,3]INT bar := ((1,2,3),(4,5,6),foo);
+      ASSERT (bar[1,1] = 1);
+      ASSERT (bar[1,2] = 2);
+      ASSERT (bar[1,3] = 3);
+      ASSERT (bar[2,1] = 4);
+      ASSERT (bar[2,2] = 5);
+      ASSERT (bar[2,3] = 6);
+      ASSERT (bar[3,1] = 7);
+      ASSERT (bar[3,2] = 8);
+      ASSERT (bar[3,3] = 9)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/row-display-3.a68
@@ -0,0 +1,15 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE FOO = STRUCT (INT i, STRING s);
+      [,]FOO matrix = (((10, "foo"), (20, "bar"), (30, "baz")),
+                       ((40, "uno"), (50, "dos"), (60, "tres")),
+                       ((70, "cuatro"), (80, "cinco"), (90, "seis")));
+      ASSERT (i OF matrix[1,1] = 10);
+      ASSERT (i OF matrix[1,2] = 20);
+      ASSERT (i OF matrix[1,3] = 30);
+      ASSERT (i OF matrix[2,1] = 40);
+      ASSERT (i OF matrix[2,2] = 50);
+      ASSERT (i OF matrix[2,3] = 60);
+      ASSERT (i OF matrix[3,1] = 70);
+      ASSERT (i OF matrix[3,2] = 80);
+      ASSERT (i OF matrix[3,3] = 90)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/row-display-4.a68
@@ -0,0 +1,16 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,][]INT duples = (((1,2), (3,4), (5,6)),
+                         ((7,8), (9,10), (11,12)));
+      ASSERT (duples[1,1][1] = 1);
+      ASSERT (duples[1,1][2] = 2);
+      ASSERT (duples[1,2][1] = 3);
+      ASSERT (duples[1,2][2] = 4);
+      ASSERT (duples[1,3][1] = 5);
+      ASSERT (duples[1,3][2] = 6);
+      ASSERT (duples[2,1][1] = 7);
+      ASSERT (duples[2,1][2] = 8);
+      ASSERT (duples[2,2][1] = 9);
+      ASSERT (duples[2,2][2] = 10);
+      ASSERT (duples[2,3][1] = 11);
+      ASSERT (duples[2,3][2] = 12)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/row-display-5.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT list1 = (1,2,3),
+            list2 = (4,5,6),
+            list3 = (7,8,9);
+      [,]INT matrix = (list1, list2, list3);
+      [,,]INT cube = (matrix, matrix, matrix);
+      ASSERT (cube[1,1,1] = 1);
+      ASSERT (cube[2,2,2] = 5);
+      ASSERT (cube[3,3,3] = 9)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rowing-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT a = 10;
+      ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1);
+      ASSERT (a[1] = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rowing-10.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 10;
+      REF[,]INT a = i;
+      ASSERT (1 LWB a = 1 AND 1 UPB a = 1 AND 1 ELEMS a = 1);
+      ASSERT (2 LWB a = 1 AND 2 UPB a = 1 AND 2 ELEMS a = 1);
+      a[1,1] := a[1,1] + 1;
+      ASSERT (a[1,1] = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rowing-11.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 10;
+      REF[,,]INT a = i;
+      ASSERT (1 LWB a = 1 AND 1 UPB a = 1 AND 1 ELEMS a = 1);
+      ASSERT (2 LWB a = 1 AND 2 UPB a = 1 AND 2 ELEMS a = 1);
+      ASSERT (3 LWB a = 1 AND 3 UPB a = 1 AND 3 ELEMS a = 1);
+      a[1,1,1] := a[1,1,1] + 1;
+      ASSERT (a[1,1,1] = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rowing-12.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Rowing of NIL yields NIL.  #
+BEGIN REF INT i = NIL;
+      REF[]INT a = i;
+      ASSERT (a :=: NIL)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rowing-13.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# Rowing of NIL yields NIL.  #
+BEGIN REF INT i = (NIL);
+      REF[,,]INT a = (i);
+      ASSERT (a :=: NIL)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rowing-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [][]INT a = 10;
+      ASSERT (a[1][1] = 10);
+      ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1);
+      ASSERT (LWB a[1] = 1 AND UPB a[1] = 1 AND ELEMS a[1] = 1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rowing-3.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [][][]INT a = 10;
+      ASSERT (a[1][1][1] = 10);
+      ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1);
+      ASSERT (LWB a[1] = 1 AND UPB a[1] = 1 AND ELEMS a[1] = 1);
+      ASSERT (LWB a[1][1] = 1 AND UPB a[1][1] = 1 AND ELEMS a[1][1] = 1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rowing-4.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE FOO = STRUCT (INT i, REAL r);
+      FOO foo = (10, 3.14);
+      [][]FOO a = foo;
+      ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1);
+      ASSERT (LWB a[1] = 1 AND UPB a[1] = 1 AND ELEMS a[1] = 1);
+      ASSERT (i OF a[1][1] = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rowing-5.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+# Rowing of a name.  #
+BEGIN INT i := 10;
+      REF[]INT a = i;
+      ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1);
+      a[1] := a[1] + 1;
+      ASSERT (a[1] = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rowing-6.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Rowing of NIL yields NIL.  #
+BEGIN REF[]INT a = REF INT(NIL);
+      ASSERT (a :=: NIL)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rowing-7.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]INT a = 10;
+      ASSERT (1 LWB a = 1 AND 1 UPB a = 1 AND 1 ELEMS a = 1);
+      ASSERT (2 LWB a = 1 AND 2 UPB a = 1 AND 2 ELEMS a = 1);
+      ASSERT (a[1,1] = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rowing-8.a68
@@ -0,0 +1,12 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT a = 10;
+      ASSERT (1 LWB a = 1 AND 1 UPB a = 1 AND 1 ELEMS a = 1);
+      [,]INT aa = a;
+      ASSERT (1 LWB aa = 1 AND 1 UPB aa = 1 AND 1 ELEMS aa = 1);
+      ASSERT (2 LWB aa = 1 AND 2 UPB aa = 1 AND 2 ELEMS aa = 1);
+      [,,]INT aaa = aa;
+      ASSERT (1 LWB aaa = 1 AND 1 UPB aaa = 1 AND 1 ELEMS aaa = 1);
+      ASSERT (2 LWB aaa = 1 AND 2 UPB aaa = 1 AND 2 ELEMS aaa = 1);
+      ASSERT (3 LWB aaa = 1 AND 3 UPB aaa = 1 AND 3 ELEMS aaa = 1);
+      ASSERT (aaa[1,1,1] = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/rowing-9.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,,]INT aaa = 10;
+      ASSERT (1 LWB aaa = 1 AND 1 UPB aaa = 1 AND 1 ELEMS aaa = 1);
+      ASSERT (2 LWB aaa = 1 AND 2 UPB aaa = 1 AND 2 ELEMS aaa = 1);
+      ASSERT (3 LWB aaa = 1 AND 3 UPB aaa = 1 AND 3 ELEMS aaa = 1);
+      ASSERT (aaa[1,1,1] = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/selection-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# Selecting a struct results in a sub-value.  #
+BEGIN MODE PERSON = STRUCT (INT age, REAL income, INT num children);
+      PERSON person = (44, 999.99, 0);
+      ASSERT (age OF person = 44);
+      ASSERT (num children OF person = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/selection-2.a68
@@ -0,0 +1,14 @@
+# { dg-options "-fstropping=upper" }  #
+# Selecting a struct name results in sub-names.  #
+BEGIN MODE PERSON = STRUCT (INT age, REAL income, INT num children);
+      PERSON person;
+      age OF person := 44;
+      income OF person := 999.99;
+      num children OF person := 0;
+      ASSERT (age OF person = 44);
+      ASSERT (num children OF person = 0);
+      REF INT ptr to age := age OF person;
+      ASSERT (ptr to age = 44);
+      age OF person := 55;
+      ASSERT (ptr to age = 55)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/selection-3.a68
@@ -0,0 +1,12 @@
+# { dg-options "-fstropping=upper" }  #
+# Structs can be nested in other structs.  #
+BEGIN MODE INCOME = STRUCT (REAL salary, stock, INT code);
+      MODE PERSON = STRUCT (INT age, INCOME income, INT num children);
+
+      PERSON person = (44, (999.99, 0.0, 10), 3);
+
+      ASSERT (age OF person = 44);
+      ASSERT (code OF income OF person = 10);
+      ASSERT (num children OF person = 3);
+      ASSERT (num children OF person * code OF income OF person = 30)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/selection-4.a68
@@ -0,0 +1,19 @@
+# { dg-options "-fstropping=upper" }  #
+# Structs can be nested in other structs.  Version with subnames.  #
+BEGIN MODE INCOME = STRUCT (REAL salary, stock, INT code);
+      MODE PERSON = STRUCT (INT age, INCOME income, INT num children);
+
+      PERSON person;
+
+      age OF person := 44;
+      salary OF income OF person := 999.99;
+      stock OF income OF person := 0.0;
+      num children OF person := 3;
+      code OF income OF person := num children OF person;
+
+      ASSERT (age OF person = 44);
+      ASSERT (code OF income OF person = num children OF person);
+      ASSERT (code OF income OF person = 3);
+      ASSERT (num children OF person = 3);
+      ASSERT (num children OF person * code OF income OF person = 9)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/selection-5.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+# pr UPPER pr  #
+BEGIN MODE JORL = STRUCT (INT i, REAL r);
+      REF JORL jorl = LOC JORL := (10, 3.14);
+      ASSERT (i OF jorl = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/selection-multiple-1.a68
@@ -0,0 +1,12 @@
+begin [10]struct (int age, string name) persons;
+
+      for i to UPB persons
+      do age of persons[i] := 20 + i;
+         name of persons[i] := "x" * i
+      od;
+
+      for i to UPB name of persons
+      do assert ((age of persons)[i] = 20 + i);
+         assert ((name of persons)[i] = "x" * i)
+      od
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/selection-multiple-2.a68
@@ -0,0 +1,18 @@
+begin [10,5]struct (int age, string name) persons;
+
+      for i to 1 UPB persons
+      do for j to 2 UPB persons
+         do age of persons[i,j] := 20 + i + j;
+            name of persons[i,j] := "x" * (i + j)
+         od
+      od;
+
+      assert (1 UPB name of persons = 10);
+      assert (2 UPB name of persons = 5);
+      for i to 1 UPB name of persons
+      do for j to 2 UPB name of persons
+         do assert ((age of persons)[i,j] = 20 + i + j);
+            assert ((name of persons)[i,j] = "x" * (i + j))
+         od
+      od
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-clause-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 10;
+      BEGIN INT i = 20; # { dg-warning "hides" } #
+            ASSERT (i = 20);
+            i
+      END;
+      ASSERT (i = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-clause-10.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# NIL is not voided and can appear in a context requiring VOID.  #
+BEGIN (NIL);
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-clause-2.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN BEGIN ASSERT (i = 0);
+            i
+      END;
+      INT i = 10;
+      ASSERT (i = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-clause-3.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (i = 0);
+      INT i = 10;
+      ASSERT (i = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-clause-4.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i := 10;
+      BEGIN ASSERT (i = 10);
+            i +:= 1
+      END;
+      ASSERT (i = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-clause-5.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN BEGIN ASSERT (i = 0);
+            i
+      END;
+      INT i := 10;
+      ASSERT (i = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-clause-6.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT ((INT y := 10;
+               INT x := 20;
+               REF INT yy;
+               (REF INT xx := x;
+                yy := y;
+                xx := yy
+               )
+              ) = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-clause-7.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT ((INT y := 10;
+               INT x := 20;
+               REF INT yy;
+               (REF INT xx := x;
+                yy := y;
+                xx + yy
+               )
+              ) = 30)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-clause-8.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT ((INT y := 10;
+               INT x := 20;
+               REF INT yy;
+               (REF INT xx := x;
+                yy := y;
+                xx
+               )
+              ) = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-clause-9.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+# Serial clause with jump at the end.  #
+
+BEGIN INT i := BEGIN BOOL cont := TRUE;
+               back: cont := FALSE;
+                     IF cont THEN GOTO back FI
+               END;
+      ASSERT (i = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-dsa-1.a68
@@ -0,0 +1,18 @@
+{ This tests stack management for DSA serial clauses.
+  If it fails a stack overflow happens.  }
+begin { DSA due to stack allocated multiple.  }
+      to 10000
+      do [10000]int foo;
+         skip
+      od;
+      { DSA due to stack allocated multiple.  Explicit loc.  }
+      to 10000
+      do loc[10000]int foo;
+         skip
+      od;
+      { DSA due to loc generator.  }
+      to 10000
+      do ref[]int jorl = loc [10000]int;
+         skip
+      od
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-dsa-2.a68
@@ -0,0 +1,5 @@
+{ Check value yielding of DSA serial clauses.  }
+begin assert ((ref int foo = loc int := 100;
+               foo) = 100);
+      assert (([10000]int foo; foo[10] := 666; foo)[10] = 666)
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-dsa-3.a68
@@ -0,0 +1,12 @@
+{ The jump to leak should not leak stack.  }
+begin by 10000
+      do
+         by 10000
+         do [10000]int foo;
+            skip;
+            goto leak
+         od;
+      leak:
+         skip
+      od
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-dsa-4.a68
@@ -0,0 +1,4 @@
+begin (ref int a = loc int := 10; goto leak; a);
+leak:
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-dsa-5.a68
@@ -0,0 +1,3 @@
+begin assert ((ref int a = loc int := 10; a) + 1 = 11);
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/serial-dsa-6.a68
@@ -0,0 +1,4 @@
+{ DSA and completers in a serial clause.  }
+begin assert ((ref int a = loc int := 10; a exit foo: a +:= 1) + 1 = 11);
+      skip
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/sign-int-1.a68
@@ -0,0 +1,28 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT zero = 0;
+      SHORT INT short zero = SHORT 0;
+      SHORT SHORT INT short short zero = SHORT SHORT 0;
+      LONG INT long zero = LONG 0;
+      LONG LONG INT long long zero = LONG LONG 0;
+      INT ten = 10;
+      SHORT INT short ten = SHORT 10;
+      SHORT SHORT INT short short ten = SHORT SHORT 10;
+      LONG INT long ten = LONG 10;
+      LONG LONG INT long long ten = LONG LONG 10;
+      ASSERT (SIGN zero = 0);
+      ASSERT (SIGN short zero = 0);
+      ASSERT (SIGN short short zero = 0);
+      ASSERT (SIGN long zero = 0);
+      ASSERT (SIGN long long zero = 0);
+      ASSERT (SIGN ten = 1);
+      ASSERT (SIGN short ten = 1);
+      ASSERT (SIGN short short ten = 1);
+      ASSERT (SIGN long ten = 1);
+      ASSERT (SIGN long long ten = 1);
+      ASSERT (SIGN -ten = -1);
+      ASSERT (SIGN -short ten = -1);
+      ASSERT (SIGN -short short ten = -1);
+      ASSERT (SIGN -long ten = -1);
+      ASSERT (SIGN -long long ten = -1)
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/sign-real-1.a68
@@ -0,0 +1,17 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL zero = 0.0;
+      LONG REAL long zero = LONG 0.0;
+      LONG LONG REAL long long zero = LONG LONG 0.0;
+      REAL ten = 10.0;
+      LONG REAL long ten = LONG 10.0;
+      LONG LONG REAL long long ten = LONG LONG 10.0;
+      ASSERT (SIGN zero = 0);
+      ASSERT (SIGN long zero = 0);
+      ASSERT (SIGN long long zero = 0);
+      ASSERT (SIGN ten = 1);
+      ASSERT (SIGN long ten = 1);
+      ASSERT (SIGN long long ten = 1);
+      ASSERT (SIGN -ten = -1);
+      ASSERT (SIGN -long ten = -1);
+      ASSERT (SIGN -long long ten = -1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/sin-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL r = 0.0;
+      LONG REAL rr = LONG 45.0;
+      LONG LONG REAL rrr = LONG LONG 60.0;
+      ASSERT (sin (r) = 0.0);
+      long sin (rr);
+      long long sin (rrr)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/skip-1.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+# Check SKIPs for INT modes #
+BEGIN INT int skip = SKIP;
+      ASSERT (int skip = 0);
+      SHORT INT short int skip = SKIP;
+      ASSERT (short int skip = SHORT 0);
+      SHORT SHORT INT short short int skip = SKIP;
+      ASSERT (short short int skip = SHORT SHORT 0);
+      LONG INT long int skip = SKIP;
+      ASSERT (long int skip = LONG 0);
+      LONG LONG INT long long int skip = SKIP;
+      ASSERT (long long int skip = LONG LONG 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/skip-2.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# Check SKIP values for BOOL and CHAR. #
+BEGIN BOOL bool skip = SKIP;
+      ASSERT (bool skip = FALSE);
+      CHAR char skip = SKIP;
+      ASSERT (char skip = " ")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/skip-struct-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE INCOME = STRUCT (REAL salary, stock, INT jorl);
+      MODE PERSON = STRUCT (INT age, INCOME income, INT num children);
+      PERSON person = SKIP;
+      ASSERT (age OF person = 0);
+      ASSERT (jorl OF income OF person = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/slice-indexing-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRING foo = "foo";
+      ASSERT (foo[1] = "f");
+      ASSERT (foo[2] = "o");
+      ASSERT (foo[3] = "o");
+      STRING bar := "foo";
+      ASSERT (bar[1] = "f");
+      ASSERT (bar[2] = "o");
+      ASSERT (bar[3] = "o")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/slice-indexing-2.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT foo = (1,2,3);
+      ASSERT (foo[1] = 1);
+      ASSERT (foo[2] = 2);
+      ASSERT (foo[3] = 3);
+      [3]INT bar := (1,2,3);
+      ASSERT (bar[1] = 1);
+      ASSERT (bar[2] = 2);
+      ASSERT (bar[3] = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/slice-indexing-3.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT foo = (10,20,30);
+      ASSERT (foo[1] = 10);
+      ASSERT (foo[2] = 20);
+      ASSERT (foo[3] = 30);
+      [3]INT bar := (100,200,300);
+      ASSERT (bar[1] = 100);
+      ASSERT (bar[2] = 200);
+      ASSERT (bar[3] = 300)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/slice-indexing-4.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE PERSON = STRUCT (INT i, STRING s);
+      []PERSON persons = ((10, "foo"), (20, "barbar"), (30, "baz"));
+      puts (s OF persons[1]);
+      puts (s OF persons[2]);
+      puts (s OF persons[3]);
+      ASSERT (i OF persons[1] = 10);
+      ASSERT (i OF persons[2] = 20);
+      ASSERT (i OF persons[3] = 30)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/slice-indexing-5.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRUCT([]INT i, REAL r) s = ((1,2,3), 3.14);
+      ASSERT ((i OF s)[1] = 1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/slice-indexing-6.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT rsp := 5;
+      [10]INT run stack;
+      run stack [(rsp -:= 1) + 1]
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/slice-indexing-7.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRING s := "foo";
+      s[2] := "x"
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/sqrt-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL r = 100.0;
+      LONG REAL rr = LONG 25.0;
+      LONG LONG REAL rrr = LONG LONG 25.0;
+      ASSERT (sqrt (r) = 10.0);
+      ASSERT (long sqrt (rr) = LONG 5.0);
+      ASSERT (long long sqrt (rrr) = LONG LONG 5.0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/string-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRING s = "";
+      ASSERT (LWB s = 1 AND UPB s = 0);
+      STRING t = ();
+      ASSERT (LWB t = 1 AND UPB t = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/string-2.a68
@@ -0,0 +1,13 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRING s;
+      ASSERT (LWB s = 1 AND UPB s = 0 AND ELEMS s = 0);
+      s := "foo";
+      puts (s);
+      ASSERT (LWB s = 1 AND UPB s = 3 AND s[1] = "f" AND s[2] = "o" AND s[3] = "o");
+      s := "bar";
+      puts (s);
+      ASSERT (LWB s = 1 AND UPB s = 3 AND s[1] = "b" AND s[2] = "a" AND s[3] = "r");
+      s := "x";
+      ASSERT (LWB s = 1 AND UPB s = 1 AND s[1] = "x");
+      puts (s)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/string-4.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRING s;
+      ASSERT (LWB s = 1 AND UPB s = 0 AND ELEMS s = 0);
+      s +:= "foo";
+      ASSERT (LWB s = 1 AND UPB s = 3 AND ELEMS s = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/string-break-1.a68
@@ -0,0 +1,8 @@
+begin assert (UPB "foo'nbar" = 7 AND "foo'nbar"[4] = REPR 10);
+      assert (UPB "foo'tbar" = 7 AND "foo'tbar"[4] = REPR 9);
+      assert (UPB "foo'rbar" = 7 AND "foo'rbar"[4] = REPR 13);
+      assert (UPB "foo'fbar" = 7 AND "foo'fbar"[4] = REPR 12);
+      assert (UPB "foo''bar" = 7 AND "foo''bar"[4] = REPR 39);
+      assert ("'(u0048,u0065,U0000006c,u006c,U0000006f)" = "Hello");
+      assert ("'( u0048,   u0065,   U0000006c,u006c,     U0000006f  )" = "Hello")
+end
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/struct-self-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE NODE = STRUCT (INT code, REF NODE next);
+      NODE top;
+      ASSERT (next OF top :=: REF NODE (NIL))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/struct-self-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE NODE = STRUCT (INT code, REF NODE next);
+      NODE top = (20, NIL);
+      ASSERT (code OF top = 20);
+      ASSERT (next OF top :=: NIL)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/struct-self-3.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE NODE = STRUCT (INT code, REF NODE next);
+      NODE top := (10, NIL);
+      NODE next := (20, NIL);
+      next OF top := next;
+      ASSERT (code OF next OF top = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/structure-display-1.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE INCOME = STRUCT (REAL salary, stock, INT code);
+      MODE PERSON = STRUCT (INT age, INCOME income, INT num children);
+      INCOME income = (100.0, 200.0, 300);
+      ASSERT (code OF income = 300);
+      PERSON person := (24, (1000.0, 2000.0, 3000), 3);
+      ASSERT (code OF income OF person = 3000);
+      ASSERT (num children OF person = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/structure-display-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE NODE = STRUCT (INT code, REF INT next);
+      INT val := 20;
+      NODE top = (10, val);
+      ASSERT (val = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/structure-display-3.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE FOO = STRUCT (INT i, REF INT j);
+      INT x := 10;
+      FOO foo;
+      foo := (10, x);
+      ASSERT (j OF foo = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/structure-display-4.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE FOO = STRUCT (INT i, REF INT j);
+      INT x := 10;
+      REF INT xx;
+      FOO foo;
+      foo := (10, xx := x);
+      ASSERT (j OF foo = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/structure-display-5.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE VEC = STRUCT (REAL xcoord, ycoord, zcoord);
+      VEC v1, v2, v3;
+      v1 := (1,1,1);
+      ASSERT (xcoord OF v1 = 1);
+      ASSERT (ycoord OF v1 = 1);
+      ASSERT (zcoord OF v1 = 1);
+      REAL x = 3.14, i = 3;
+      v2 := (x + 2, 3.4, i - 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/tan-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REAL r = 0.0;
+      LONG REAL rr = LONG 50.0;
+      LONG LONG REAL rrr = LONG LONG 50.0;
+      ASSERT (tan (r) = 0.0);
+      long tan (rr);
+      long long tan (rrr)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/timesab-string-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN STRING foo := "foo";
+      foo TIMESAB 1;
+      ASSERT (foo = "foo");
+      foo *:= 3;
+      ASSERT (foo = "foofoofoo")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+      ASSERT (arr[3] = 2 AND arr[4] = 3);
+      []INT jorl = arr[2:3@20];
+      ASSERT (LWB jorl = 20 AND UPB jorl = 21);
+      ASSERT (jorl[20] = 1 AND jorl [21] = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-10.a68
@@ -0,0 +1,14 @@
+# { dg-options "-fstropping=upper" }  #
+# Trimming with flat descriptors should lead to flat multiples.  #
+BEGIN []INT a = (1,2,3);
+
+      ASSERT (UPB a[2:1] < LWB a[2:1]);
+      ASSERT (UPB a[20:2] < LWB a[20:2]);
+
+      [,]INT aa = ((1,2,3),
+                   (4,5,6),
+                   (7,8,9));
+      
+      ASSERT ((1 UPB aa[1,2:1]) < ((1 LWB aa[1,2:1])));
+      ASSERT ((1 UPB aa[1,20:]) < ((1 LWB aa[1,20:])))
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-2.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+      ASSERT (arr[3] = 2 AND arr[4] = 3);
+      []INT jorl = arr[2:3];
+      ASSERT (LWB jorl = 1 AND UPB jorl = 2);
+      ASSERT (jorl[1] = 1 AND jorl [2] = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-3.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+      ASSERT (arr[3] = 2 AND arr[4] = 3);
+      []INT jorl = arr[:@20];
+      ASSERT (LWB jorl = 20 AND UPB jorl = 22);
+      ASSERT (jorl[20] = 1 AND jorl[21] = 2 AND jorl[22] = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-4.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+      ASSERT (arr[3] = 2 AND arr[4] = 3);
+      []INT jorl = arr[3:];
+      ASSERT (LWB jorl = 1 AND UPB jorl = 2);
+      ASSERT (jorl[1] = 2 AND jorl[2] = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-5.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+      ASSERT (arr[3] = 2 AND arr[4] = 3);
+      []INT jorl = arr[:3 AT 10];
+      ASSERT (LWB jorl = 10 AND UPB jorl = 11);
+      ASSERT (jorl[10] = 1 AND jorl[11] = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-6.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+      ASSERT (arr[3] = 2 AND arr[4] = 3);
+      []INT jorl = arr[:3@10];
+      ASSERT (LWB jorl = 10 AND UPB jorl = 11);
+      ASSERT (jorl[10] = 1 AND jorl[11] = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-7.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT arr = (1,2,3);
+      ASSERT (arr[2] = 2 AND arr[3] = 3);
+      []INT jorl = arr[2:3@20];
+      ASSERT (LWB jorl = 20 AND UPB jorl = 21);
+      ASSERT (jorl[20] = 2 AND jorl [21] = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-8.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [2:4]INT arr := []INT(1,2,3)[@2];
+      ASSERT (arr[3] = 2 AND arr[4] = 3);
+      [10:11]INT jorl := arr[:3 AT 10];
+      ASSERT (LWB jorl = 10 AND UPB jorl = 11);
+      ASSERT (jorl[10] = 1 AND jorl[11] = 2);
+      jorl[10] := 100;
+      ASSERT (jorl[10] = 100 AND jorl[11] = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-9.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT arr = (1,2,3);
+      ASSERT (arr[2] = 2 AND arr[3] = 3);
+      []INT jorl = arr[@20];
+      ASSERT (LWB jorl = 20 AND UPB jorl = 22);
+      ASSERT (jorl[20] = 1 AND jorl [21] = 2 AND jorl [22] = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-matrix-1.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]INT matrix = ((1,2,3),
+                       (4,5,6),
+                       (7,8,9));
+      [2]INT column := matrix[3,2:3];
+      ASSERT (column[1] = 8);
+      ASSERT (column[2] = 9)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-matrix-2.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]INT matrix = ((1,2,3),
+                       (4,5,6),
+                       (7,8,9));
+      [2]INT column := matrix[2,1:2];
+      ASSERT (column[1] = 4);
+      ASSERT (column[2] = 5)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-matrix-3.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]INT matrix = ((1,2,3),
+                       (4,5,6),
+                       (7,8,9));
+      [3]INT column := matrix[2,1:3];
+      ASSERT (column[1] = 4);
+      ASSERT (column[2] = 5);
+      ASSERT (column[3] = 6)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-matrix-4.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]INT matrix = ((1,2,3),
+                       (4,5,6),
+                       (7,8,9));
+      []INT column = matrix[1:3,2];
+      ASSERT (LWB column = 1);
+      ASSERT (UPB column = 3);
+      ASSERT (column[1] = 2 AND column[2] = 5 AND column[3] = 8)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-matrix-5.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]INT matrix = ((1,2,3),
+                       (4,5,6),
+                       (7,8,9));
+      []INT column = matrix[2:3,2];
+      ASSERT (LWB column = 1);
+      ASSERT (UPB column = 2);
+      ASSERT (column[1] = 5 AND column[2] = 8)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-matrix-6.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [,]INT matrix = ((1,2,3),
+                       (4,5,6),
+                       (7,8,9));
+      []INT row = matrix[3,1:3];
+      ASSERT (LWB row = 1);
+      ASSERT (UPB row = 3);
+      ASSERT (row[1] = 7 AND row[2] = 8 AND row[3] = 9)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/trimmer-name-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN REF[]CHAR t;
+      PROC foo = VOID: (HEAP[3]CHAR ss := ("1","2","3"); t := ss[1:3]);
+      foo;
+      ASSERT (LWB t = 1 AND UPB t = 3);
+      ASSERT (t[1] = "1" AND t[2] = "2" AND t[3] = "3")
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/undefined-1.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+# j's value is undefined (defined to be 0 in GNU Algol)  #
+BEGIN INT x := 0;
+      FOR i TO 5
+      DO ASSERT (j = 0);
+         IF j > 20 THEN stop FI;
+         INT j = x + i;
+         x +:= 1
+      OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/undefined-2.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+# The undefined value of the multiple `a' is an empty multiple. #
+BEGIN ASSERT (i = 0);
+      ASSERT (LWB a = 1 AND UPB a = 0 AND ELEMS a = 0);
+      []INT a = (1, 2, 3);
+      INT i = 10;
+      ASSERT (i = 10);
+      ASSERT (LWB a = 1 AND UPB a = 3 AND ELEMS a = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/undefined-3.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (sum = 1);
+      PROC sum = INT: i + 1;
+      INT i = 10;
+      ASSERT (sum = 11)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/undefined-4.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC is even = (INT n) BOOL: (n = zero | TRUE | is odd (n - 1));
+      PROC is odd = (INT n) BOOL: (n = zero | FALSE | is even (n - 1));
+      ASSERT (is even (20));
+      ASSERT (is odd (13));
+      INT zero := 0;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/undefined-5.a68
@@ -0,0 +1,9 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN PROC is even = (INT n) BOOL: (n = zero | TRUE | is odd (DECR n));
+      PROC is odd = (INT n) BOOL: (n = zero | FALSE | is even (DECR n));
+      OP DECR = (INT a) INT:  a - 1;
+      ASSERT (is even (20));
+      ASSERT (is odd (13));
+      INT zero := 0;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/uniting-1.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN UNION(INT,REAL,CHAR) datum := 3.14;
+      UNION(INT,REAL,[]INT,CHAR) datux;
+      datux := datum;
+      ASSERT (CASE datux
+              IN (INT): 10,
+                 (REAL): 20,
+                 (CHAR c): 30
+              ESAC = 20);
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/uniting-2.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN UNION(INT,REAL,CHAR) datum := "X";
+      UNION(INT,REAL,[]INT,CHAR) datux;
+      datux := datum;
+      ASSERT (CASE datux
+              IN (INT): 10,
+                 (REAL): 20,
+                 (CHAR c): 30
+              ESAC = 30);
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/uniting-3.a68
@@ -0,0 +1,11 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN UNION(INT,REAL,CHAR) datum := 10;
+      UNION(INT,REAL,[]INT,CHAR) datux;
+      datux := datum;
+      ASSERT (CASE datux
+              IN (INT): 10,
+                 (REAL): 20,
+                 (CHAR c): 30
+              ESAC = 10);
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/uniting-4.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+# Uniting STRING to ROWS.  #
+BEGIN PROC strlen = (STRING s) INT: ELEMS s;
+      ASSERT (strlen ("foo") = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/up-down-bits-1.a68
@@ -0,0 +1,33 @@
+# { dg-options "-fstropping=upper" }  #
+# SHORTEN and LENG on SIZETY BITS #
+BEGIN BITS b = 16rff;
+      ASSERT (b UP 4 = 16rff0);
+      ASSERT (b SHL 4 = 16rff0);
+      ASSERT (b DOWN 4 = 16r0f);
+      ASSERT (b SHR 4 = 16r0f);
+
+      LONG BITS bb = LONG 16rff;
+      ASSERT (bb UP 4 = LONG 16rff0);
+      ASSERT (bb SHL 4 = LONG 16rff0);
+      ASSERT (bb DOWN 4 = LONG 16r0f);
+      ASSERT (bb SHR 4 = LONG 16r0f);
+
+      LONG LONG BITS bbb = LONG LONG 16rff;
+      ASSERT (bbb UP 4 = LONG LONG 16rff0);
+      ASSERT (bbb SHL 4 = LONG LONG 16rff0);
+      ASSERT (bbb DOWN 4 = LONG LONG 16r0f);
+      ASSERT (bbb SHR 4 = LONG LONG 16r0f);
+
+      SHORT BITS ss = SHORT 16rff;
+      ASSERT (ss UP 4 = SHORT 16rff0);
+      ASSERT (ss SHL 4 = SHORT 16rff0);
+      ASSERT (ss DOWN 4 = SHORT 16r0f);
+      ASSERT (ss SHR 4 = SHORT 16r0f);
+
+      SHORT SHORT BITS sss = SHORT SHORT 16r0f;
+      ASSERT (sss UP 4 = SHORT SHORT 16rf0);
+      ASSERT (sss SHL 4 = SHORT SHORT 16rf0);
+      ASSERT (sss DOWN 2 = SHORT SHORT 16r03);
+      ASSERT (sss SHR 2 = SHORT SHORT 16r03)
+END
+
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/upb-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN ASSERT (UPB "foo" = 3);
+      ASSERT (1 UPB "foo" = 3);
+      ASSERT (UPB "" = 0);
+      ASSERT ((INT i = 1; UPB "") = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/vacuum-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN []INT a = ();
+      ASSERT (LWB a = 1 AND UPB a = 0)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      REF INT xx := x := 20;
+      ASSERT (xx = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-2.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      REF INT xx := x;
+      ASSERT (xx = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-3.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      REF INT xx := (x := 20);
+      ASSERT (xx = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-4.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      REF INT xx := ((x));
+      ASSERT (xx = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-5.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT x := 10;
+      REF REF INT xx := LOC REF INT := x := 20;
+      ASSERT (xx = 20)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-6.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN MODE FOO = STRUCT (STRING s, INT i);
+      FOO f1 := ("foo", 10);
+      ASSERT (i OF f1 = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-heap-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN HEAP INT a := 10;
+      ASSERT (a = 10)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-heap-2.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN HEAP INT x, y;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-multiple-1.a68
@@ -0,0 +1,5 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [10,3]INT arr;
+      ASSERT (1 LWB arr = 1 AND 1 UPB arr = 10 AND 1 ELEMS arr = 10);
+      ASSERT (2 LWB arr = 1 AND 2 UPB arr = 3 AND 2 ELEMS arr = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-multiple-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n = 10;
+      [n,3]INT arr;
+      ASSERT (1 LWB arr = 1 AND 1 UPB arr = 10 AND 1 ELEMS arr = 10);
+      ASSERT (2 LWB arr = 1 AND 2 UPB arr = 3 AND 2 ELEMS arr = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-multiple-3.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n := 10, m := 3;
+      [n,m]INT arr;
+      ASSERT (1 LWB arr = 1 AND 1 UPB arr = 10 AND 1 ELEMS arr = 10);
+      ASSERT (2 LWB arr = 1 AND 2 UPB arr = 3 AND 2 ELEMS arr = 3)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-multiple-4.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n := -4, m := 0;
+      [n:m,2]INT arr;
+      ASSERT (1 LWB arr = -4 AND 1 UPB arr = 0 AND 1 ELEMS arr = 5);
+      ASSERT (2 LWB arr = 1 AND 2 UPB arr = 2 AND 2 ELEMS arr = 2)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-multiple-5.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n := -4, m := 0;
+      [n:m,2]INT arr;
+      FOR i FROM 1 LWB arr TO 1 UPB arr
+      DO FOR j FROM 2 LWB arr TO 2 UPB arr
+         DO ASSERT (arr[i,j] = INT(SKIP)) OD
+      OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-multiple-6.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n := -4, m := 0;
+      [n:m,2]REF INT arr;
+      FOR i FROM 1 LWB arr TO 1 UPB arr
+      DO FOR j FROM 2 LWB arr TO 2 UPB arr
+         DO ASSERT (REF INT (arr[i,j]) :=: REF INT(SKIP)) OD
+      OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-multiple-7.a68
@@ -0,0 +1,8 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n := 2, m := 3;
+      [n][m]INT arr;
+      FOR i FROM LWB arr TO UPB arr
+      DO FOR j FROM LWB arr[i] TO UPB arr[i]
+         DO ASSERT (arr[i][j] = INT(SKIP)) OD
+      OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-multiple-8.a68
@@ -0,0 +1,10 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT n := -4, m := 0;
+      [10][n:m,2]INT arr;
+      FOR k FROM LWB arr TO UPB arr
+      DO FOR i FROM 1 LWB arr[k] TO 1 UPB arr[k]
+         DO FOR j FROM 2 LWB arr[k] TO 2 UPB arr[k]
+            DO ASSERT (arr[k][i,j] = INT(SKIP)) OD
+         OD
+      OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/variable-declaration-multiple-9.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN [4]INT x, y;
+      SKIP
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/voiding-1.a68
@@ -0,0 +1,4 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i;
+      2 = i
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/widening-1.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN INT i = 10;
+      REAL foo = i;
+      ASSERT (foo > 9.9);
+      ASSERT (foo < 10.1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/widening-2.a68
@@ -0,0 +1,6 @@
+# { dg-options "-fstropping=upper" }  #
+BEGIN LONG INT i = LONG 10;
+      LONG REAL foo = i;
+      ASSERT (foo > LONG 9.9);
+      ASSERT (foo < LONG 10.1)
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/widening-bits-1.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# XXX use environment enquiry for actual size of BITS #
+BEGIN []BOOL foo = 16rffff;
+      ASSERT (LWB foo = 1 AND UPB foo = 32);
+      FOR i TO 16 DO ASSERT (foo[i] = FALSE) OD;
+      FOR i FROM 17 TO 32 DO ASSERT (foo[i] = TRUE) OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/widening-bits-2.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# XXX use environment enquiry for actual size of LONG BITS #
+BEGIN []BOOL foo = LONG 16rffffffff;
+      ASSERT (LWB foo = 1 AND UPB foo = 64);
+      FOR i TO 32 DO ASSERT (foo[i] = FALSE) OD;
+      FOR i FROM 33 TO 64 DO ASSERT (foo[i] = TRUE) OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/widening-bits-3.a68
@@ -0,0 +1,7 @@
+# { dg-options "-fstropping=upper" }  #
+# XXX use environment enquiry for actual size of LONG LONG BITS #
+BEGIN []BOOL foo = LONG LONG 16rffffffff;
+      ASSERT (LWB foo = 1 AND UPB foo = 64);
+      FOR i TO 32 DO ASSERT (foo[i] = FALSE) OD;
+      FOR i FROM 33 TO 64 DO ASSERT (foo[i] = TRUE) OD
+END
--- /dev/null
+++ b/src/gcc/testsuite/algol68/execute/xor-bits-1.a68
@@ -0,0 +1,18 @@
+# { dg-options "-fstropping=upper" }  #
+# XOR for SIZETY BITS.  #
+BEGIN BITS b = 16rf0f0;
+      ASSERT ((b XOR 16r0f0f) = 16rffff);
+      ASSERT ((b XOR 16r00ff) = 16rf00f);
+      LONG BITS bb = LONG 16rf0f0;
+      ASSERT ((bb XOR LONG 16r0f0f) = LONG 16rffff);
+      ASSERT ((bb XOR LONG 16r00ff) = LONG 16rf00f);
+      LONG LONG BITS bbb = LONG LONG 16rf0f0;
+      ASSERT ((bbb XOR LONG LONG 16r0f0f) = LONG LONG 16rffff);
+      ASSERT ((bbb XOR LONG LONG 16r00ff) = LONG LONG 16rf00f);
+      SHORT BITS ss = SHORT 16rf0f0;
+      ASSERT ((ss XOR SHORT 16r0f0f) = SHORT 16rffff);
+      ASSERT ((ss XOR SHORT 16r00ff) = SHORT 16rf00f);
+      SHORT SHORT BITS sss = SHORT SHORT 16rf0;
+      ASSERT ((sss XOR SHORT SHORT 16r0f) = SHORT SHORT 16rff);
+      ASSERT ((sss XOR SHORT SHORT 16rff) = SHORT SHORT 16r0f)
+END
--- /dev/null
+++ b/src/gcc/testsuite/lib/algol68-dg.exp
@@ -0,0 +1,57 @@
+# Copyright (C) 1997-2024 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 ALGOL68 callbacks for dg.exp.
+
+proc algol68-dg-test { prog do_what extra_tool_flags } {
+    return [gcc-dg-test-1 algol68_target_compile $prog $do_what $extra_tool_flags]
+}
+
+proc algol68-dg-prune { system text } {
+    return [gcc-dg-prune $system $text]
+}
+
+# Modified dg-runtest that can cycle through a list of optimization options
+# as c-torture does.
+proc algol68-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 { -O2 } ]
+	}
+
+	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}
+	}
+    }
+}
--- /dev/null
+++ b/src/gcc/testsuite/lib/algol68-torture.exp
@@ -0,0 +1,430 @@
+# Copyright (C) 2009-2024 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/>.
+
+# Please email any bugs, comments, and/or additions to this file to
+# the author.
+
+load_lib dg.exp
+
+load_lib target-supports.exp
+
+load_lib target-utils.exp
+
+# The default option list can be overridden by
+# TORTURE_OPTIONS="{ { list1 } ... { listN } }"
+
+if ![info exists TORTURE_OPTIONS] {
+    set TORTURE_OPTIONS [list \
+	{ -O0 } { -O1 } { -O2 } \
+	{ -O2 -fomit-frame-pointer -finline-functions } \
+	{ -O2 -fomit-frame-pointer -finline-functions -funroll-loops } \
+	{ -O2 -fno-a68-bounds-checking } \
+	{ -O2 -fa68-nil-checking } \
+	{ -O3 -g } \
+	{ -Os }]
+
+    if [check_effective_target_lto] {
+	set TORTURE_OPTIONS \
+	    [concat $TORTURE_OPTIONS [list {-flto}]]
+    }
+}
+
+#
+# algol68-torture-compile -- compile an algol68/execute/torture testcase.
+#
+# SRC is the full pathname of the testcase.
+# OPTION is the specific compiler flag we're testing (eg: -O2).
+#
+proc algol68-torture-compile { src option } {
+    global output
+    global srcdir tmpdir
+    global host_triplet
+
+    set output "$tmpdir/[file tail [file rootname $src]].o"
+
+    regsub "(?q)$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 get results in comp_output.
+    set options ""
+    lappend options "additional_flags=-w $option"
+
+    set comp_output [algol68_target_compile "$src" "$output" object $options]
+    
+    # See if we got something bad.
+    set fatal_signal "*algol68*: Internal compiler error: program*got fatal signal"
+ 
+    if [string match "$fatal_signal 6" $comp_output] then {
+	algol68_fail $testcase "Got Signal 6, $option"
+	catch { remote_file build delete $output }
+	return
+    }
+
+    if [string match "$fatal_signal 11" $comp_output] then {
+	algol68_fail $testcase "Got Signal 11, $option"
+	catch { remote_file build delete $output }
+	return
+    }
+
+    if [regexp -line -- "internal compiler error.*" $comp_output ice] then {
+	algol68_fail $testcase "$option ($ice)"
+	catch { remote_file build delete $output }
+	return
+    }
+
+    # We shouldn't get these because of -w, but just in case.
+    if [string match "*algol68*:*warning:*" $comp_output] then {
+	warning "$testcase: (with warnings) $option"
+	send_log "$comp_output\n"
+	unresolved "$testcase, $option"
+	catch { remote_file build delete $output }
+	return
+    }
+
+    # Prune warnings we know are unwanted.
+    set comp_output [prune_warnings $comp_output]
+
+    # Report if the testcase is not supported.
+    set unsupported_message [algol68_check_unsupported_p $comp_output]
+    if { $unsupported_message != "" } {
+	unsupported "$testcase: $unsupported_message"
+	catch { remote_file build delete $output }
+	return
+    }
+
+    # remove any leftover LF/CR to make sure any output is legit
+    regsub -all -- "\[\r\n\]*" $comp_output "" comp_output
+
+    # If any message remains, we fail.
+    if ![string match "" $comp_output] then {
+	algol68_fail $testcase $option
+	catch { remote_file build delete $output }
+	return
+    }
+
+    algol68_pass $testcase $option
+    catch { remote_file build delete $output }
+}
+
+
+#
+# algol68-torture-execute -- compile and execute a testcase.
+#
+# SRC is the full pathname of 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 algol68-torture-execute { src } {
+    global output
+    global srcdir tmpdir
+    global tool
+    global compiler_conditional_xfail_data
+    global TORTURE_OPTIONS
+    global errorCode errorInfo
+    global algol68_compile_args
+    global algol68_execute_args
+    global dg-extra-tool-flags
+
+    set dg-excess-errors-flag 0
+    set dg-messages ""
+    set dg-extra-tool-flags ""
+    set dg-final-code ""
+
+    # `dg-output-text' is a list of two elements: pass/fail and text.
+    # Leave second element off for now (indicates "don't perform test")
+    set dg-output-text "P"
+
+    set tmp [dg-get-options $src]
+    foreach op $tmp {
+        verbose "Processing option: $op" 3
+        set status [catch $op errmsg]
+        if { $status != 0 } {
+            if { 0 && [info exists errorInfo] } {
+                # This also prints a backtrace which will just confuse
+                # testcase writers, so it's disabled.
+                perror "$src: $errorInfo\n"
+            } else {
+                perror "$src: $errmsg for \"$op\"\n"
+            }
+            perror "$src: $errmsg for \"$op\"" 0
+            return
+        }
+    }
+
+    # Check for alternate driver.
+    set additional_flags ""
+    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
+	}
+    }
+
+    # Setup the options for the testcase run.
+    set option_list $TORTURE_OPTIONS
+    set executable $tmpdir/[file tail [file rootname $src].x]
+    regsub "(?q)$srcdir/" $src "" testcase
+
+    if { ! [info exists algol68_compile_args] } {
+	set algol68_compile_args ""
+    }
+    if { ! [info exists algol68_execute_args] } {
+	set algol68_execute_args ""
+    }
+
+    # 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]"
+    }
+
+    # Walk the list of options and compile and run the testcase for all
+    # options that are not explicitly disabled by the .x script (if present).
+    foreach option $option_list {
+
+	# Torture_{compile,execute}_xfail are set by the .x script.
+	if [info exists torture_compile_xfail] {
+	    setup_xfail $torture_compile_xfail
+	}
+
+	# Torture_execute_before_{compile,execute} can be set by the .x script.
+	if [info exists torture_eval_before_compile] {
+            set ignore_me [eval $torture_eval_before_compile]
+	}
+
+	# FIXME: We should make sure that the modules required by this testcase
+	# exist.  If not, the testcase should XFAIL.
+
+	# Compile the testcase.
+	catch { remote_file build delete $executable }
+	verbose "Testing $testcase, $option" 1
+
+	set options ""
+	lappend options "additional_flags=-w $option"
+	if { ${dg-extra-tool-flags} != "" } {
+	    lappend options "additional_flags=${dg-extra-tool-flags}"
+	}
+	if { $additional_flags != "" } {
+	    lappend options "additional_flags=$additional_flags"
+	}
+	if { $algol68_compile_args != "" } {
+	    lappend options "additional_flags=$algol68_compile_args"
+	}
+	set comp_output [algol68_target_compile "$src" "$executable" executable $options]
+
+	# See if we got something bad.
+	set fatal_signal "*algol68*: Internal compiler error: program*got fatal signal"
+	
+	if [string match "$fatal_signal 6" $comp_output] then {
+	    algol68_fail $testcase "Got Signal 6, $option"
+	    catch { remote_file build delete $executable }
+	    continue
+	}
+	
+	if [string match "$fatal_signal 11" $comp_output] then {
+	    algol68_fail $testcase "Got Signal 11, $option"
+	    catch { remote_file build delete $executable }
+	    continue
+	}
+
+	if [regexp -line -- "internal compiler error.*" $comp_output ice] then {
+	    algol68_fail $testcase "$option ($ice)"
+	    catch { remote_file build delete $executable }
+	    continue
+	}
+	
+	# We shouldn't get these because of -w, but just in case.
+	if [string match "*algol68*:*warning:*" $comp_output] then {
+	    warning "$testcase: (with warnings) $option"
+	    send_log "$comp_output\n"
+	    unresolved "$testcase, $option"
+	    catch { remote_file build delete $executable }
+	    continue
+	}
+	
+	# Prune warnings we know are unwanted.
+	set comp_output [prune_warnings $comp_output]
+
+	# Report if the testcase is not supported.
+	set unsupported_message [algol68_check_unsupported_p $comp_output]
+	if { $unsupported_message != "" } {
+	    unsupported "$testcase: $unsupported_message"
+	    continue
+	} elseif ![file exists $executable] {
+	    if ![is3way] {
+		fail "$testcase compilation, $option"
+		untested "$testcase execution, $option"
+		continue
+	    } else {
+		# FIXME: since we can't test for the existence of a remote
+		# file without short of doing an remote file list, we assume
+		# that since we got no output, it must have compiled.
+		pass "$testcase compilation, $option"		
+	    }
+	} else {
+	    pass "$testcase compilation, $option"
+	}
+
+	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]
+	}
+
+	# Run the testcase, and analyse the output.
+	set result [algol68_load "$executable" "$algol68_execute_args" ""]
+	set status [lindex $result 0]
+	set output [lindex $result 1]
+	if { $status eq "pass" } {
+	    pass "$testcase execution test, $option"
+	    verbose "Exec succeeded." 3
+	    if { [llength ${dg-output-text}] > 1 } {
+		if { [lindex ${dg-output-text} 0] eq "F" } {
+		    setup_xfail "*-*-*"
+		}
+		set texttmp [lindex ${dg-output-text} 1]
+		if { ![regexp -- $texttmp $output] } {
+		    fail "$testcase output pattern test, $option"
+		    send_log "Output was:\n${output}\nShould match:\n$texttmp\n"
+		    verbose "Failed test for output pattern $texttmp" 3
+		} else {
+		    pass "$testcase output pattern test, $option"
+		    verbose "Passed test for output pattern $texttmp" 3
+		}
+		unset texttmp
+	    }
+	} elseif { $status eq "fail" } {
+	    if {[info exists errorCode]} {
+		verbose "Exec failed, errorCode: $errorCode" 3
+	    } else {
+		verbose "Exec failed, errorCode not defined!" 3
+	    }
+	    fail "$testcase execution test, $option"
+	} else {
+	    $status "$testcase execution, $option"
+	}
+	catch { remote_file build delete $executable }
+    }
+}
+
+
+#
+# search_for_re -- looks for a string match in a file
+#
+proc search_for_re { file pattern } {
+    set fd [open $file r]
+    while { [gets $fd cur_line]>=0 } {
+	set lower [string tolower $cur_line]
+	if [regexp "$pattern" $lower] then {
+	    close $fd
+	    return 1
+	}
+    }
+    close $fd
+    return 0
+}
+
+
+#
+# algol68-torture -- the algol68-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 algol68-torture { args } {
+    global srcdir subdir
+    global compiler_conditional_xfail_data
+    global 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
+	}
+    }
+   
+    # loop through all the options
+    set option_list $TORTURE_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]
+	}
+
+	algol68-torture-compile $src "$option $options"
+    }
+}
+
+#
+# add-ieee-options -- add options necessary for 100% ieee conformance.
+#
+proc add-ieee-options { } {
+    # Ensure that excess precision does not cause problems.
+    if { [istarget i?86-*-*]
+	 || [istarget m68k-*-*] } then {
+      uplevel 1 lappend additional_flags "-ffloat-store"
+    }
+
+    # Enable full IEEE compliance mode.
+    if { [istarget alpha*-*-*]
+         || [istarget sh*-*-*] } then {
+      uplevel 1 lappend additional_flags "-mieee"
+    }
+}
--- /dev/null
+++ b/src/gcc/testsuite/lib/algol68.exp
@@ -0,0 +1,217 @@
+# Copyright (C) 2012-2024 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/>.
+
+#
+# ALGOL68 support library routines
+#
+
+load_lib prune.exp
+load_lib gcc-defs.exp
+load_lib timeout.exp
+load_lib target-libpath.exp
+
+#
+# ALGOL68_UNDER_TEST is the compiler under test.
+#
+
+set algol68_compile_options ""
+
+
+#
+# algol68_include_flags -- include flags for the gcc tree structure
+#
+
+proc algol68_include_flags { paths } {
+    global srcdir
+    global TESTING_IN_BUILD_TREE
+
+    set flags ""
+
+    if { [is_remote host] || ![info exists TESTING_IN_BUILD_TREE] } {
+	return "${flags}"
+    }
+
+    set gccpath ${paths}
+
+    return "$flags"
+}
+
+#
+# algol68_link_flags -- linker flags for the gcc tree structure
+#
+
+proc algol68_link_flags { paths } {
+    global srcdir
+    global ld_library_path
+    global shlib_ext
+    global SHARED_OPTION
+    global ALGOL68_UNDER_TEST
+
+    set gccpath ${paths}
+    set libio_dir ""
+    set flags ""
+    set ld_library_path "."
+    set shlib_ext [get_shlib_extension]
+    set SHARED_OPTION ""
+    verbose "shared lib extension: $shlib_ext"
+
+    # We need to add options to locate libga68.
+    set target_wants_B_option 0
+    if { [istarget *-*-darwin9* ] || [istarget *-*-darwin\[12\]* ] } {
+      set target_wants_B_option 1
+    }
+
+    if { $gccpath != "" } {
+	# Path to libga68.spec.
+	append flags "-B${gccpath}/libga68 "
+	if { [file exists "${gccpath}/libga68/.libs/libga68.a"] \
+	     || [file exists "${gccpath}/libga68/.libs/libga68.${shlib_ext}"] } {
+	    if { $target_wants_B_option } {
+		append flags "-B${gccpath}/libga68/.libs "
+	    } else {
+		append flags "-L${gccpath}/libga68/.libs "
+	    }
+	    append ld_library_path ":${gccpath}/libga68/.libs"
+	}
+	# Static linking is default. If only the shared lib is available adjust
+	# flags to always use it. If both are available, set SHARED_OPTION which
+	# will be added to PERMUTE_ARGS
+	if { [file exists "${gccpath}/libga68/src/.libs/libga68.${shlib_ext}"] } {
+	    if { [file exists "${gccpath}/libga68/src/.libs/libga68.a"] } {
+		set SHARED_OPTION "-shared-libga68"
+	    } else {
+#		append flags "-shared-libga68 "
+	    }
+	}
+	if [file exists "${gccpath}/libiberty/libiberty.a"] {
+	    append flags "-L${gccpath}/libiberty "
+	}
+	append ld_library_path [gcc-set-multilib-library-path $ALGOL68_UNDER_TEST]
+    }
+
+    set_ld_library_path_env_vars
+
+    return "$flags"
+}
+
+#
+# algol68_init -- called at the start of each subdir of tests
+#
+
+proc algol68_init { args } {
+    global subdir
+    global algol68_initialized
+    global base_dir
+    global tmpdir
+    global libdir
+    global gluefile wrap_flags
+    global objdir srcdir
+    global ALWAYS_ALGOL68FLAGS
+    global TOOL_EXECUTABLE TOOL_OPTIONS
+    global ALGOL68_UNDER_TEST
+    global TESTING_IN_BUILD_TREE
+    global gcc_warning_prefix
+    global gcc_error_prefix
+
+    # We set LC_ALL and LANG to C so that we get the same error messages as expected.
+    setenv LC_ALL C
+    setenv LANG C
+
+    if ![info exists ALGOL68_UNDER_TEST] then {
+	if [info exists TOOL_EXECUTABLE] {
+	    set ALGOL68_UNDER_TEST $TOOL_EXECUTABLE
+	} else {
+	    if { [is_remote host] || ! [info exists TESTING_IN_BUILD_TREE] } {
+		set ALGOL68_UNDER_TEST [transform ga68]
+	    } else {
+		set ALGOL68_UNDER_TEST [findfile $base_dir/../../ga68 "$base_dir/../../ga68 -B$base_dir/../../" [findfile $base_dir/ga68 "$base_dir/ga68 -B$base_dir/" [transform ga68]]]
+	    }
+	}
+    }
+
+    if ![is_remote host] {
+	if { [which $ALGOL68_UNDER_TEST] == 0 } then {
+	    perror "ALGOL68_UNDER_TEST ($ALGOL68_UNDER_TEST) does not exist"
+	    exit 1
+	}
+    }
+
+    if ![info exists tmpdir] {
+	set tmpdir "/tmp"
+    }
+
+    if [info exists gluefile] {
+	unset gluefile
+    }
+
+    set gcc_warning_prefix "warning:"
+    set gcc_error_prefix "(fatal )?error:"
+
+    verbose "algol68 is initialized" 3
+}
+
+#
+# algol68_target_compile -- compile a source file
+#
+
+proc algol68_target_compile { source dest type options } {
+    global tmpdir
+    global gluefile wrap_flags
+    global ALWAYS_ALGOL68FLAGS
+    global ALGOL68_UNDER_TEST
+    global individual_timeout
+    global TEST_ALWAYS_FLAGS
+
+    # HACK: guard against infinite loops in the compiler
+    set individual_timeout 20
+
+    if { [target_info needs_status_wrapper] != "" && [info exists gluefile] } {
+	lappend options "libs=${gluefile}"
+	lappend options "ldflags=${wrap_flags}"
+    }
+
+    set ALWAYS_ALGOL68FLAGS ""
+
+    # 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] {
+	lappend ALWAYS_ALGOL68FLAGS "additional_flags=$TEST_ALWAYS_FLAGS"
+    }
+
+    if ![is_remote host] {
+	if [info exists TOOL_OPTIONS] {
+	    lappend ALWAYS_ALGOL68FLAGS "additional_flags=[algol68_include_flags [get_multilibs ${TOOL_OPTIONS}] ]"
+	    lappend ALWAYS_ALGOL68FLAGS "ldflags=[algol68_link_flags [get_multilibs ${TOOL_OPTIONS}] ]"
+	} else {
+	    lappend ALWAYS_ALGOL68FLAGS "additional_flags=[algol68_include_flags [get_multilibs] ]"
+	    lappend ALWAYS_ALGOL68FLAGS "ldflags=[algol68_link_flags [get_multilibs] ]"
+	}
+    }
+
+    if [info exists TOOL_OPTIONS] {
+	lappend ALWAYS_ALGOL68FLAGS "additional_flags=$TOOL_OPTIONS"
+    }
+
+    verbose -log "ALWAYS_ALGOL68FLAGS set to $ALWAYS_ALGOL68FLAGS"
+
+    lappend options "timeout=[timeout_value]"
+    lappend options "compiler=$ALGOL68_UNDER_TEST"
+
+    set options [concat "$ALWAYS_ALGOL68FLAGS" $options]
+    set options [dg-additional-files-options $options $source $dest $type]
+    return [target_compile $source $dest $type $options]
+}
--- a/src/include/dwarf2.h
+++ b/src/include/dwarf2.h
@@ -409,6 +409,7 @@ enum dwarf_source_language
     DW_LANG_Ruby = 0x0040,
     DW_LANG_Move = 0x0041,
     DW_LANG_Hylo = 0x0042,
+    DW_LANG_Algol68 = 0x0044,
 
     DW_LANG_lo_user = 0x8000,	/* Implementation-defined range start.  */
     DW_LANG_hi_user = 0xffff,	/* Implementation-defined range end.  */
@@ -425,7 +426,7 @@ enum dwarf_source_language
     DW_LANG_HP_Assembler = 0x8007,
 
     /* Rust extension, but replaced in DWARF 5.  */
-    DW_LANG_Rust_old = 0x9000
+    DW_LANG_Rust_old = 0x9000,
   };
 
 /* DWARF 6 source language names and codes.  */
@@ -476,6 +477,7 @@ enum dwarf_source_language_name
     DW_LNAME_Odin = 0x002a,
     DW_LNAME_P4 = 0x002b,
     DW_LNAME_Metal = 0x002c,
+    DW_LNAME_Algol68 = 0x002e,
 
     DW_LNAME_lo_user = 0x8000,	/* Implementation-defined range start.  */
     DW_LNAME_hi_user = 0xffff	/* Implementation-defined range end.  */
--- /dev/null
+++ b/src/libga68/Makefile.am
@@ -0,0 +1,122 @@
+# Makefile for libga68.
+#   Copyright (C) 2025 Jose E. Marchesi.
+#
+# 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.69
+
+AUTOMAKE_OPTIONS = 1.8 foreign
+ACLOCAL_AMFLAGS = -I .. -I ../config
+# Multilib support.
+MAKEOVERRIDES=
+
+gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER)
+TOP_GCCDIR := $(shell cd $(top_srcdir) && cd .. && pwd)
+
+GCC_DIR = $(TOP_GCCDIR)/gcc
+A68_SRC = $(GCC_DIR)/algol68
+
+toolexeclibdir=@toolexeclibdir@
+toolexecdir=@toolexecdir@
+A68_FOR_TARGET=@A68_FOR_TARGET@
+
+extra_darwin_ldflags_libga68=@extra_darwin_ldflags_libga68@
+
+if ENABLE_DARWIN_AT_RPATH
+extra_darwin_ldflags_libga68 += -Wc,-nodefaultrpaths
+extra_darwin_ldflags_libga68 += -Wl,-rpath,@loader_path
+endif
+
+A68_BUILDDIR := $(shell pwd)
+
+# 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)" \
+        "A68_SRC=$(A68_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"A68_FOR_TARGET=$(A68_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+        "CFLAGS_LONGDOUBLE=$(CFLAGS_LONGDOUBLE)" \
+	"EXPECT=$(EXPECT)" \
+	"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)" \
+	"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=$(A68_BUILDDIR)/libtool" \
+	"DARWIN_AT_RPATH=$(DARWIN_AT_RPATH)"
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+
+gcc_objdir = $(MULTIBUILDTOP)../../$(host_subdir)/gcc
+
+toolexeclib_DATA = libga68.spec
+toolexeclib_LTLIBRARIES = libga68.la
+
+libga68_la_SOURCES = libga68.c \
+                     ga68-unistr.c \
+                     ga68-posix.c \
+                     ga68-alloc.c \
+                     ga68-error.c \
+                     ga68-standenv.c \
+                     ga68.h
+libga68_la_LIBTOOLFLAGS =
+libga68_la_CFLAGS = $(LIBGA68_GCFLAGS) $(LIBGA68_BOEHM_GC_INCLUDES)
+libga68_la_LDFLAGS = -version-info $(libga68_VERSION) \
+    $(extra_darwin_ldflags_libga68)
+libga68_la_DEPENDENCIES = libga68.spec
+libga68_la_LIBADD = $(LIBGA68_BOEHM_GC_LIBS)
+
+# target overrides
+-include $(tmake_file)
+
+include $(top_srcdir)/../multilib.am
--- /dev/null
+++ b/src/libga68/Makefile.in
@@ -0,0 +1,906 @@
+# 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 libga68.
+#   Copyright (C) 2025 Jose E. Marchesi.
+#
+# 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.69
+
+
+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@
+@ENABLE_DARWIN_AT_RPATH_TRUE@am__append_1 = -Wc,-nodefaultrpaths \
+@ENABLE_DARWIN_AT_RPATH_TRUE@	-Wl,-rpath,@loader_path
+subdir = .
+ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
+am__aclocal_m4_deps = $(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)/../libtool.m4 $(top_srcdir)/../ltoptions.m4 \
+	$(top_srcdir)/../ltsugar.m4 $(top_srcdir)/../ltversion.m4 \
+	$(top_srcdir)/../lt~obsolete.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 = libga68.spec
+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)" \
+	"$(DESTDIR)$(toolexeclibdir)"
+LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
+am__DEPENDENCIES_1 =
+am_libga68_la_OBJECTS = libga68_la-libga68.lo \
+	libga68_la-ga68-unistr.lo libga68_la-ga68-posix.lo \
+	libga68_la-ga68-alloc.lo libga68_la-ga68-error.lo \
+	libga68_la-ga68-standenv.lo
+libga68_la_OBJECTS = $(am_libga68_la_OBJECTS)
+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 = 
+libga68_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC \
+	$(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=link $(CCLD) \
+	$(libga68_la_CFLAGS) $(CFLAGS) $(libga68_la_LDFLAGS) \
+	$(LDFLAGS) -o $@
+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@
+depcomp = $(SHELL) $(top_srcdir)/../depcomp
+am__depfiles_maybe = depfiles
+am__mv = mv -f
+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 = $(libga68_la_SOURCES)
+am__can_run_installinfo = \
+  case $$AM_UPDATE_INFO_DIR in \
+    n|no|NO) false;; \
+    *) (install-info --version) >/dev/null 2>&1;; \
+  esac
+DATA = $(toolexeclib_DATA)
+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
+AM_RECURSIVE_TARGETS = cscope
+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@
+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@
+LIBGA68_BOEHM_GC_INCLUDES = @LIBGA68_BOEHM_GC_INCLUDES@
+LIBGA68_BOEHM_GC_LIBS = @LIBGA68_BOEHM_GC_LIBS@
+LIBGA68_GCFLAGS = @LIBGA68_GCFLAGS@
+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@
+RANLIB = @RANLIB@
+SED = @SED@
+SET_MAKE = @SET_MAKE@
+SHELL = @SHELL@
+SPEC_LIBGA68_DEPS = @SPEC_LIBGA68_DEPS@
+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@
+extra_darwin_ldflags_libga68 = @extra_darwin_ldflags_libga68@ \
+	$(am__append_1)
+get_gcc_base_ver = @get_gcc_base_ver@
+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@
+libga68_VERSION = @libga68_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@
+AUTOMAKE_OPTIONS = 1.8 foreign
+ACLOCAL_AMFLAGS = -I .. -I ../config
+# Multilib support.
+MAKEOVERRIDES = 
+gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER)
+TOP_GCCDIR := $(shell cd $(top_srcdir) && cd .. && pwd)
+GCC_DIR = $(TOP_GCCDIR)/gcc
+A68_SRC = $(GCC_DIR)/algol68
+A68_FOR_TARGET = @A68_FOR_TARGET@
+A68_BUILDDIR := $(shell pwd)
+
+# 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)" \
+        "A68_SRC=$(A68_SRC)" \
+	"AR_FLAGS=$(AR_FLAGS)" \
+	"CC_FOR_BUILD=$(CC_FOR_BUILD)" \
+	"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
+	"A68_FOR_TARGET=$(A68_FOR_TARGET)" \
+	"CFLAGS=$(CFLAGS)" \
+	"CXXFLAGS=$(CXXFLAGS)" \
+	"CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \
+	"CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \
+        "CFLAGS_LONGDOUBLE=$(CFLAGS_LONGDOUBLE)" \
+	"EXPECT=$(EXPECT)" \
+	"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)" \
+	"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=$(A68_BUILDDIR)/libtool" \
+	"DARWIN_AT_RPATH=$(DARWIN_AT_RPATH)"
+
+
+# Subdir rules rely on $(FLAGS_TO_PASS)
+FLAGS_TO_PASS = $(AM_MAKEFLAGS)
+gcc_objdir = $(MULTIBUILDTOP)../../$(host_subdir)/gcc
+toolexeclib_DATA = libga68.spec
+toolexeclib_LTLIBRARIES = libga68.la
+libga68_la_SOURCES = libga68.c \
+                     ga68-unistr.c \
+                     ga68-posix.c \
+                     ga68-alloc.c \
+                     ga68-error.c \
+                     ga68-standenv.c \
+                     ga68.h
+
+libga68_la_LIBTOOLFLAGS = 
+libga68_la_CFLAGS = $(LIBGA68_GCFLAGS) $(LIBGA68_BOEHM_GC_INCLUDES)
+libga68_la_LDFLAGS = -version-info $(libga68_VERSION) \
+    $(extra_darwin_ldflags_libga68)
+
+libga68_la_DEPENDENCIES = libga68.spec
+libga68_la_LIBADD = $(LIBGA68_BOEHM_GC_LIBS)
+MULTISRCTOP = 
+MULTIBUILDTOP = 
+MULTIDIRS = 
+MULTISUBDIR = 
+MULTIDO = true
+MULTICLEAN = true
+all: config.h
+	$(MAKE) $(AM_MAKEFLAGS) all-am
+
+.SUFFIXES:
+.SUFFIXES: .c .lo .o .obj
+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
+libga68.spec: $(top_builddir)/config.status $(srcdir)/libga68.spec.in
+	cd $(top_builddir) && $(SHELL) ./config.status $@
+
+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}; \
+	}
+
+libga68.la: $(libga68_la_OBJECTS) $(libga68_la_DEPENDENCIES) $(EXTRA_libga68_la_DEPENDENCIES) 
+	$(AM_V_CCLD)$(libga68_la_LINK) -rpath $(toolexeclibdir) $(libga68_la_OBJECTS) $(libga68_la_LIBADD) $(LIBS)
+
+mostlyclean-compile:
+	-rm -f *.$(OBJEXT)
+
+distclean-compile:
+	-rm -f *.tab.c
+
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libga68_la-ga68-alloc.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libga68_la-ga68-error.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libga68_la-ga68-posix.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libga68_la-ga68-standenv.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libga68_la-ga68-unistr.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libga68_la-libga68.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 $@ $<
+
+libga68_la-libga68.lo: libga68.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -MT libga68_la-libga68.lo -MD -MP -MF $(DEPDIR)/libga68_la-libga68.Tpo -c -o libga68_la-libga68.lo `test -f 'libga68.c' || echo '$(srcdir)/'`libga68.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libga68_la-libga68.Tpo $(DEPDIR)/libga68_la-libga68.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='libga68.c' object='libga68_la-libga68.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 $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -c -o libga68_la-libga68.lo `test -f 'libga68.c' || echo '$(srcdir)/'`libga68.c
+
+libga68_la-ga68-unistr.lo: ga68-unistr.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -MT libga68_la-ga68-unistr.lo -MD -MP -MF $(DEPDIR)/libga68_la-ga68-unistr.Tpo -c -o libga68_la-ga68-unistr.lo `test -f 'ga68-unistr.c' || echo '$(srcdir)/'`ga68-unistr.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libga68_la-ga68-unistr.Tpo $(DEPDIR)/libga68_la-ga68-unistr.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='ga68-unistr.c' object='libga68_la-ga68-unistr.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 $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -c -o libga68_la-ga68-unistr.lo `test -f 'ga68-unistr.c' || echo '$(srcdir)/'`ga68-unistr.c
+
+libga68_la-ga68-posix.lo: ga68-posix.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -MT libga68_la-ga68-posix.lo -MD -MP -MF $(DEPDIR)/libga68_la-ga68-posix.Tpo -c -o libga68_la-ga68-posix.lo `test -f 'ga68-posix.c' || echo '$(srcdir)/'`ga68-posix.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libga68_la-ga68-posix.Tpo $(DEPDIR)/libga68_la-ga68-posix.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='ga68-posix.c' object='libga68_la-ga68-posix.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 $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -c -o libga68_la-ga68-posix.lo `test -f 'ga68-posix.c' || echo '$(srcdir)/'`ga68-posix.c
+
+libga68_la-ga68-alloc.lo: ga68-alloc.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -MT libga68_la-ga68-alloc.lo -MD -MP -MF $(DEPDIR)/libga68_la-ga68-alloc.Tpo -c -o libga68_la-ga68-alloc.lo `test -f 'ga68-alloc.c' || echo '$(srcdir)/'`ga68-alloc.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libga68_la-ga68-alloc.Tpo $(DEPDIR)/libga68_la-ga68-alloc.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='ga68-alloc.c' object='libga68_la-ga68-alloc.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 $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -c -o libga68_la-ga68-alloc.lo `test -f 'ga68-alloc.c' || echo '$(srcdir)/'`ga68-alloc.c
+
+libga68_la-ga68-error.lo: ga68-error.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -MT libga68_la-ga68-error.lo -MD -MP -MF $(DEPDIR)/libga68_la-ga68-error.Tpo -c -o libga68_la-ga68-error.lo `test -f 'ga68-error.c' || echo '$(srcdir)/'`ga68-error.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libga68_la-ga68-error.Tpo $(DEPDIR)/libga68_la-ga68-error.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='ga68-error.c' object='libga68_la-ga68-error.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 $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -c -o libga68_la-ga68-error.lo `test -f 'ga68-error.c' || echo '$(srcdir)/'`ga68-error.c
+
+libga68_la-ga68-standenv.lo: ga68-standenv.c
+@am__fastdepCC_TRUE@	$(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -MT libga68_la-ga68-standenv.lo -MD -MP -MF $(DEPDIR)/libga68_la-ga68-standenv.Tpo -c -o libga68_la-ga68-standenv.lo `test -f 'ga68-standenv.c' || echo '$(srcdir)/'`ga68-standenv.c
+@am__fastdepCC_TRUE@	$(AM_V_at)$(am__mv) $(DEPDIR)/libga68_la-ga68-standenv.Tpo $(DEPDIR)/libga68_la-ga68-standenv.Plo
+@AMDEP_TRUE@@am__fastdepCC_FALSE@	$(AM_V_CC)source='ga68-standenv.c' object='libga68_la-ga68-standenv.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 $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -c -o libga68_la-ga68-standenv.lo `test -f 'ga68-standenv.c' || echo '$(srcdir)/'`ga68-standenv.c
+
+mostlyclean-libtool:
+	-rm -f *.lo
+
+clean-libtool:
+	-rm -rf .libs _libs
+
+distclean-libtool:
+	-rm -f libtool config.lt
+install-toolexeclibDATA: $(toolexeclib_DATA)
+	@$(NORMAL_INSTALL)
+	@list='$(toolexeclib_DATA)'; test -n "$(toolexeclibdir)" || list=; \
+	if test -n "$$list"; then \
+	  echo " $(MKDIR_P) '$(DESTDIR)$(toolexeclibdir)'"; \
+	  $(MKDIR_P) "$(DESTDIR)$(toolexeclibdir)" || exit 1; \
+	fi; \
+	for p in $$list; do \
+	  if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
+	  echo "$$d$$p"; \
+	done | $(am__base_list) | \
+	while read files; do \
+	  echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(toolexeclibdir)'"; \
+	  $(INSTALL_DATA) $$files "$(DESTDIR)$(toolexeclibdir)" || exit $$?; \
+	done
+
+uninstall-toolexeclibDATA:
+	@$(NORMAL_UNINSTALL)
+	@list='$(toolexeclib_DATA)'; test -n "$(toolexeclibdir)" || list=; \
+	files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \
+	dir='$(DESTDIR)$(toolexeclibdir)'; $(am__uninstall_files_from_dir)
+
+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"
+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-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
+	-rm -f cscope.out cscope.in.out cscope.po.out cscope.files
+check-am: all-am
+check: check-am
+all-am: Makefile $(LTLIBRARIES) $(DATA) config.h all-local
+installdirs:
+	for dir in "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)"; do \
+	  test -z "$$dir" || $(MKDIR_P) "$$dir"; \
+	done
+install: 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."
+clean: clean-am
+
+clean-am: clean-generic clean-libtool clean-local \
+	clean-toolexeclibLTLIBRARIES mostlyclean-am
+
+distclean: distclean-am
+	-rm -f $(am__CONFIG_DISTCLEAN_FILES)
+	-rm -rf ./$(DEPDIR)
+	-rm -f Makefile
+distclean-am: clean-am distclean-compile distclean-generic \
+	distclean-hdr distclean-libtool distclean-local distclean-tags
+
+dvi: dvi-am
+
+dvi-am:
+
+html: html-am
+
+html-am:
+
+info: info-am
+
+info-am:
+
+install-data-am:
+
+install-dvi: install-dvi-am
+
+install-dvi-am:
+
+install-exec-am: install-exec-local install-toolexeclibDATA \
+	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 -f $(am__CONFIG_DISTCLEAN_FILES)
+	-rm -rf $(top_srcdir)/autom4te.cache
+	-rm -rf ./$(DEPDIR)
+	-rm -f Makefile
+maintainer-clean-am: distclean-am maintainer-clean-generic \
+	maintainer-clean-local
+
+mostlyclean: mostlyclean-am
+
+mostlyclean-am: mostlyclean-compile mostlyclean-generic \
+	mostlyclean-libtool mostlyclean-local
+
+pdf: pdf-am
+
+pdf-am:
+
+ps: ps-am
+
+ps-am:
+
+uninstall-am: uninstall-toolexeclibDATA \
+	uninstall-toolexeclibLTLIBRARIES
+
+.MAKE: all install-am install-strip
+
+.PHONY: CTAGS GTAGS TAGS all all-am all-local am--refresh check \
+	check-am clean clean-cscope clean-generic clean-libtool \
+	clean-local clean-toolexeclibLTLIBRARIES cscope cscopelist-am \
+	ctags ctags-am distclean distclean-compile 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 install-toolexeclibDATA \
+	install-toolexeclibLTLIBRARIES installcheck installcheck-am \
+	installdirs maintainer-clean maintainer-clean-generic \
+	maintainer-clean-local mostlyclean mostlyclean-compile \
+	mostlyclean-generic mostlyclean-libtool mostlyclean-local pdf \
+	pdf-am ps ps-am tags tags-am uninstall uninstall-am \
+	uninstall-toolexeclibDATA uninstall-toolexeclibLTLIBRARIES
+
+.PRECIOUS: Makefile
+
+
+# target overrides
+-include $(tmake_file)
+
+# 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:
--- /dev/null
+++ b/src/libga68/README
@@ -0,0 +1,2 @@
+This is the GNU Algol 68 run-time library.  It provides the run-time
+components needed by programs compiled by the ga68 compiler.
--- /dev/null
+++ b/src/libga68/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([../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])
+m4_include([../libtool.m4])
+m4_include([../ltoptions.m4])
+m4_include([../ltsugar.m4])
+m4_include([../ltversion.m4])
+m4_include([../lt~obsolete.m4])
--- /dev/null
+++ b/src/libga68/config.h.in
@@ -0,0 +1,97 @@
+/* config.h.in.  Generated from configure.ac by autoheader.  */
+
+/* Define to 1 if you have the <dlfcn.h> header file. */
+#undef HAVE_DLFCN_H
+
+/* Define to 1 if you have the <inttypes.h> header file. */
+#undef HAVE_INTTYPES_H
+
+/* Define to 1 if you have the <malloc.h> header file. */
+#undef HAVE_MALLOC_H
+
+/* Define to 1 if you have the <memory.h> header file. */
+#undef HAVE_MEMORY_H
+
+/* Define to 1 if you have the <stdint.h> header file. */
+#undef HAVE_STDINT_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 <sys/stat.h> header file. */
+#undef HAVE_SYS_STAT_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 <unistd.h> header file. */
+#undef HAVE_UNISTD_H
+
+/* 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
--- /dev/null
+++ b/src/libga68/configure
@@ -0,0 +1,19735 @@
+#! /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='libga68'
+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
+LIBGA68_BOEHM_GC_LIBS
+LIBGA68_BOEHM_GC_INCLUDES
+LIBGA68_GCFLAGS
+extra_darwin_ldflags_libga68
+get_gcc_base_ver
+libga68_VERSION
+SPEC_LIBGA68_DEPS
+CC_FOR_BUILD
+enable_static
+enable_shared
+ENABLE_DARWIN_AT_RPATH_FALSE
+ENABLE_DARWIN_AT_RPATH_TRUE
+CXXCPP
+OTOOL64
+OTOOL
+LIPO
+NMEDIT
+DSYMUTIL
+OBJDUMP
+LN_S
+ac_ct_DUMPBIN
+DUMPBIN
+LD
+FGREP
+SED
+LIBTOOL
+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
+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
+enable_darwin_at_rpath
+enable_algol68_gc
+with_target_bdw_gc
+with_target_bdw_gc_include
+with_target_bdw_gc_lib
+with_gcc_major_version_only
+'
+      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/libga68]
+  --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)
+  --enable-darwin-at-rpath
+                          install libraries with @rpath/library-name, requires
+                          rpaths to be added to executables
+  --enable-algol68-gc     enable use of Boehm's garbage collector with the GNU
+                          Algol runtime
+
+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]
+  --with-target-bdw-gc=PATHLIST
+                          specify prefix directory for installed bdw-gc
+                          package. Equivalent to
+                          --with-target-bdw-gc-include=PATH/include plus
+                          --with-target-bdw-gc-lib=PATH/lib
+  --with-target-bdw-gc-include=PATHLIST
+                          specify directories for installed bdw-gc include
+                          files
+  --with-target-bdw-gc-lib=PATHLIST
+                          specify directories for installed bdw-gc library
+  --with-gcc-major-version-only
+                          use only GCC major number in filesystem paths
+
+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
+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_headers="$ac_config_headers config.h"
+
+
+# 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}
+
+
+if test "$build" != "$host"; then
+  # We are being configured with some form of cross compiler.
+  GLIBCXX_IS_NATIVE=false
+  case "$host","$target" in
+    # Darwin crosses can use the host system's libraries and headers,
+    # because of the fat library support.  Of course, it must be the
+    # same version of Darwin on both sides.  Allow the user to
+    # just say --target=foo-darwin without a version number to mean
+    # "the version on this system".
+      *-*-darwin*,*-*-darwin*)
+	hostos=`echo $host | sed 's/.*-darwin/darwin/'`
+	targetos=`echo $target | sed 's/.*-darwin/darwin/'`
+	if test $hostos = $targetos || test $targetos = darwin ; then
+	  GLIBCXX_IS_NATIVE=true
+	fi
+	;;
+
+      *)
+
+	;;
+  esac
+else
+  GLIBCXX_IS_NATIVE=true
+fi
+
+# Runs configure.host, and assorted other critical bits.  Sets
+# up critical shell variables.
+GLIBCXX_CONFIGURE
+
+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='libga68'
+ 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.
+for ac_header in malloc.h
+do :
+  ac_fn_c_check_header_mongrel "$LINENO" "malloc.h" "ac_cv_header_malloc_h" "$ac_includes_default"
+if test "x$ac_cv_header_malloc_h" = xyes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_MALLOC_H 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
+
+{ $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 nm to test.
+   lt_nm_to_check="$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
+ 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=.
+     # Strip out any user-provided options from the nm to test twice,
+     # the first time to test to see if nm (rather than its options) has
+     # an explicit path, the second time to yield a file which can be
+     # nm'ed itself.
+     tmp_nm_path="`$ECHO "$lt_tmp_nm" | sed 's, -.*$,,'`"
+     case "$tmp_nm_path" in
+     */*|*\\*) tmp_nm="$lt_tmp_nm";;
+     *) tmp_nm="$ac_dir/$lt_tmp_nm";;
+     esac
+     tmp_nm_to_nm="`$ECHO "$tmp_nm" | sed 's, -.*$,,'`"
+     if test -f "$tmp_nm_to_nm" || test -f "$tmp_nm_to_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
+       case `"$tmp_nm" -B "$tmp_nm_to_nm" 2>&1 | grep -v '^ *$' | sed '1q'` in
+       *$tmp_nm*) lt_cv_path_NM="$tmp_nm -B"
+	 break
+	 ;;
+       *)
+	 case `"$tmp_nm" -p "$tmp_nm_to_nm" 2>&1 | grep -v '^ *$' | sed '1q'` in
+	 *$tmp_nm*)
+	   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
+{ $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
+
+
+
+
+
+
+
+
+
+
+
+
+plugin_option=
+plugin_names="liblto_plugin.so liblto_plugin-0.dll cyglto_plugin-0.dll"
+for plugin in $plugin_names; do
+  plugin_so=`${CC} ${CFLAGS} --print-prog-name $plugin`
+  if test x$plugin_so = x$plugin; then
+    plugin_so=`${CC} ${CFLAGS} --print-file-name $plugin`
+  fi
+  if test x$plugin_so != x$plugin; then
+    plugin_option="--plugin $plugin_so"
+    break
+  fi
+done
+
+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
+if test -n "$plugin_option"; then
+  if $AR --help 2>&1 | grep -q "\--plugin"; then
+    touch conftest.c
+    $AR $plugin_option rc conftest.a conftest.c
+    if test "$?" != 0; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Failed: $AR $plugin_option rc" >&5
+$as_echo "$as_me: WARNING: Failed: $AR $plugin_option rc" >&2;}
+    else
+      AR="$AR $plugin_option"
+    fi
+    rm -f conftest.*
+  fi
+fi
+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=:
+if test -n "$plugin_option" && test "$RANLIB" != ":"; then
+  if $RANLIB --help 2>&1 | grep -q "\--plugin"; then
+    RANLIB="$RANLIB $plugin_option"
+  fi
+fi
+
+
+
+
+
+
+# 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='[BCDRT]'
+  ;;
+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][0-9]*)
+	  ;;
+	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*)
+
+
+
+  # Publish an arg to allow the user to select that Darwin host (and target)
+  # libraries should be given install-names like @rpath/libfoo.dylib.  This
+  # requires that the user of the library then adds an 'rpath' to the DSO that
+  # needs access.
+  # NOTE: there are defaults below, for systems that support rpaths.  The person
+  # configuring can override the defaults for any system version that supports
+  # them - they are, however, forced off for system versions without support.
+  # Check whether --enable-darwin-at-rpath was given.
+if test "${enable_darwin_at_rpath+set}" = set; then :
+  enableval=$enable_darwin_at_rpath; if test "x$enable_darwin_at_rpath" = "xyes"; then
+    # This is not supported before macOS 10.5 / Darwin9.
+    case ${MACOSX_DEPLOYMENT_TARGET-UNSET},$host_os in
+      UNSET,darwin[4-8]*|UNSET,rhapsody*|10.[0-4][,.]*)
+	{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Darwin @rpath library names are incompatible with OSX versions earlier than 10.5 (rpaths disabled)" >&5
+$as_echo "$as_me: WARNING: Darwin @rpath library names are incompatible with OSX versions earlier than 10.5 (rpaths disabled)" >&2;}
+	enable_darwin_at_rpath=no
+      ;;
+    esac
+   fi
+else
+  case ${MACOSX_DEPLOYMENT_TARGET-UNSET},$host_os in
+    # As above, before 10.5 / Darwin9 this does not work.
+     UNSET,darwin[4-8]*|UNSET,rhapsody*|10.[0-4][,.]*)
+       enable_darwin_at_rpath=no
+       ;;
+
+    # We cannot build and test reliably on macOS 10.11+ (Darwin15+) without use
+    # of rpaths, since runpaths set via DYLD_LIBRARY_PATH are elided by key
+    # system executables (e.g. /bin/sh).  Force rpaths on for these systems.
+      UNSET,darwin1[5-9]*|UNSET,darwin2*|10.1[1-9][,.]*|1[1-9].*[,.]* )
+      { $as_echo "$as_me:${as_lineno-$LINENO}: @rpath library names are needed on macOS versions later than 10.11 (rpaths have been enabled)" >&5
+$as_echo "$as_me: @rpath library names are needed on macOS versions later than 10.11 (rpaths have been enabled)" >&6;}
+      enable_darwin_at_rpath=yes
+      ;;
+    # NOTE: we are not (yet) doing anything for 10.5 .. 10.10, since they can
+    # work with either DYLD_LIBRARY_PATH or embedded rpaths.
+
+    esac
+
+fi
+
+
+  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
+    _lt_install_name='\$rpath/\$soname'
+    if test "x$enable_darwin_at_rpath" = "xyes"; then
+      _lt_install_name='@rpath/\$soname'
+    fi
+    archive_cmds="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name ${_lt_install_name} \$verstring ${_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 ${_lt_install_name} \$verstring ${_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/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 12565 "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 12671 "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*)
+
+
+
+  # Publish an arg to allow the user to select that Darwin host (and target)
+  # libraries should be given install-names like @rpath/libfoo.dylib.  This
+  # requires that the user of the library then adds an 'rpath' to the DSO that
+  # needs access.
+  # NOTE: there are defaults below, for systems that support rpaths.  The person
+  # configuring can override the defaults for any system version that supports
+  # them - they are, however, forced off for system versions without support.
+  # Check whether --enable-darwin-at-rpath was given.
+if test "${enable_darwin_at_rpath+set}" = set; then :
+  enableval=$enable_darwin_at_rpath; if test "x$enable_darwin_at_rpath" = "xyes"; then
+    # This is not supported before macOS 10.5 / Darwin9.
+    case ${MACOSX_DEPLOYMENT_TARGET-UNSET},$host_os in
+      UNSET,darwin[4-8]*|UNSET,rhapsody*|10.[0-4][,.]*)
+	{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Darwin @rpath library names are incompatible with OSX versions earlier than 10.5 (rpaths disabled)" >&5
+$as_echo "$as_me: WARNING: Darwin @rpath library names are incompatible with OSX versions earlier than 10.5 (rpaths disabled)" >&2;}
+	enable_darwin_at_rpath=no
+      ;;
+    esac
+   fi
+else
+  case ${MACOSX_DEPLOYMENT_TARGET-UNSET},$host_os in
+    # As above, before 10.5 / Darwin9 this does not work.
+     UNSET,darwin[4-8]*|UNSET,rhapsody*|10.[0-4][,.]*)
+       enable_darwin_at_rpath=no
+       ;;
+
+    # We cannot build and test reliably on macOS 10.11+ (Darwin15+) without use
+    # of rpaths, since runpaths set via DYLD_LIBRARY_PATH are elided by key
+    # system executables (e.g. /bin/sh).  Force rpaths on for these systems.
+      UNSET,darwin1[5-9]*|UNSET,darwin2*|10.1[1-9][,.]*|1[1-9].*[,.]* )
+      { $as_echo "$as_me:${as_lineno-$LINENO}: @rpath library names are needed on macOS versions later than 10.11 (rpaths have been enabled)" >&5
+$as_echo "$as_me: @rpath library names are needed on macOS versions later than 10.11 (rpaths have been enabled)" >&6;}
+      enable_darwin_at_rpath=yes
+      ;;
+    # NOTE: we are not (yet) doing anything for 10.5 .. 10.10, since they can
+    # work with either DYLD_LIBRARY_PATH or embedded rpaths.
+
+    esac
+
+fi
+
+
+  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
+    _lt_install_name='\$rpath/\$soname'
+    if test "x$enable_darwin_at_rpath" = "xyes"; then
+      _lt_install_name='@rpath/\$soname'
+    fi
+    archive_cmds_CXX="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name ${_lt_install_name} \$verstring ${_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 ${_lt_install_name} \$verstring ${_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
+      _lt_install_name='\$rpath/\$soname'
+      if test "x$enable_darwin_at_rpath" = "xyes"; then
+        _lt_install_name='@rpath/\$soname'
+      fi
+      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 ${_lt_install_name} \$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/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
+
+
+
+
+ if test x$enable_darwin_at_rpath = xyes; then
+  ENABLE_DARWIN_AT_RPATH_TRUE=
+  ENABLE_DARWIN_AT_RPATH_FALSE='#'
+else
+  ENABLE_DARWIN_AT_RPATH_TRUE='#'
+  ENABLE_DARWIN_AT_RPATH_FALSE=
+fi
+
+
+
+
+
+if test "${multilib}" = "yes"; then
+  multilib_arg="--enable-multilib"
+else
+  multilib_arg=
+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
+
+
+
+
+
+
+CC_FOR_BUILD=${CC_FOR_BUILD:-gcc}
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing malloc" >&5
+$as_echo_n "checking for library containing malloc... " >&6; }
+if ${ac_cv_search_malloc+:} 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 malloc ();
+int
+main ()
+{
+return malloc ();
+  ;
+  return 0;
+}
+_ACEOF
+for ac_lib in '' c; 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 test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_search_malloc=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext
+  if ${ac_cv_search_malloc+:} false; then :
+  break
+fi
+done
+if ${ac_cv_search_malloc+:} false; then :
+
+else
+  ac_cv_search_malloc=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_malloc" >&5
+$as_echo "$ac_cv_search_malloc" >&6; }
+ac_res=$ac_cv_search_malloc
+if test "$ac_res" != no; then :
+  test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing cosf" >&5
+$as_echo_n "checking for library containing cosf... " >&6; }
+if ${ac_cv_search_cosf+:} 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 cosf ();
+int
+main ()
+{
+return cosf ();
+  ;
+  return 0;
+}
+_ACEOF
+for ac_lib in '' m; 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 test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_search_cosf=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext
+  if ${ac_cv_search_cosf+:} false; then :
+  break
+fi
+done
+if ${ac_cv_search_cosf+:} false; then :
+
+else
+  ac_cv_search_cosf=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_cosf" >&5
+$as_echo "$ac_cv_search_cosf" >&6; }
+ac_res=$ac_cv_search_cosf
+if test "$ac_res" != no; then :
+  test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+
+fi
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing clock_gettime" >&5
+$as_echo_n "checking for library containing clock_gettime... " >&6; }
+if ${ac_cv_search_clock_gettime+:} 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 clock_gettime ();
+int
+main ()
+{
+return clock_gettime ();
+  ;
+  return 0;
+}
+_ACEOF
+for ac_lib in '' rt; 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 test x$gcc_no_link = xyes; then
+  as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
+fi
+if ac_fn_c_try_link "$LINENO"; then :
+  ac_cv_search_clock_gettime=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext
+  if ${ac_cv_search_clock_gettime+:} false; then :
+  break
+fi
+done
+if ${ac_cv_search_clock_gettime+:} false; then :
+
+else
+  ac_cv_search_clock_gettime=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_clock_gettime" >&5
+$as_echo "$ac_cv_search_clock_gettime" >&6; }
+ac_res=$ac_cv_search_clock_gettime
+if test "$ac_res" != no; then :
+  test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+
+fi
+
+
+# Add dependencies for libga68.spec file
+SPEC_LIBGA68_DEPS="$LIBS"
+
+
+# libga68 soname version
+libga68_VERSION=1:0:0
+
+
+# The Boehm GC
+
+# Check whether --enable-algol68-gc was given.
+if test "${enable_algol68_gc+set}" = set; then :
+  enableval=$enable_algol68_gc;
+else
+  enable_algol68_gc=no
+fi
+
+
+# Check whether --with-target-bdw-gc was given.
+if test "${with_target_bdw_gc+set}" = set; then :
+  withval=$with_target_bdw_gc;
+fi
+
+
+# Check whether --with-target-bdw-gc-include was given.
+if test "${with_target_bdw_gc_include+set}" = set; then :
+  withval=$with_target_bdw_gc_include;
+fi
+
+
+# Check whether --with-target-bdw-gc-lib was given.
+if test "${with_target_bdw_gc_lib+set}" = set; then :
+  withval=$with_target_bdw_gc_lib;
+fi
+
+
+bdw_lib_dir=
+case "$enable_algol68_gc" in
+no)
+  use_bdw_gc=no
+  ;;
+*)
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bdw garbage collector" >&5
+$as_echo_n "checking for bdw garbage collector... " >&6; }
+  if test "x$with_target_bdw_gc$with_target_bdw_gc_include$with_target_bdw_gc_lib" = x; then
+        BDW_GC_CFLAGS=
+    BDW_GC_LIBS="-lgc"
+  else
+        if test "x$with_target_bdw_gc_include" = x && test "x$with_target_bdw_gc_lib" != x; then
+      as_fn_error $? "found --with-target-bdw-gc-lib but --with-target-bdw-gc-include missing" "$LINENO" 5
+    elif test "x$with_target_bdw_gc_include" != x && test "x$with_target_bdw_gc_lib" = x; then
+      as_fn_error $? "found --with-target-bdw-gc-include but --with-target-bdw-gc-lib missing" "$LINENO" 5
+    else
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: using paths configured with --with-target-bdw-gc options" >&5
+$as_echo "using paths configured with --with-target-bdw-gc options" >&6; }
+    fi
+    mldir=`${CC-gcc} --print-multi-directory 2>/dev/null`
+    bdw_val=
+    if test "x$with_target_bdw_gc" != x; then
+      for i in `echo $with_target_bdw_gc | tr ',' ' '`; do
+        case "$i" in
+          *=*) sd=${i%%=*}; d=${i#*=} ;;
+          *) sd=.; d=$i ;;
+        esac
+        if test "$mldir" = "$sd"; then
+          bdw_val=$d
+        fi
+      done
+      if test "x$bdw_val" = x; then
+        as_fn_error $? "no multilib path ($mldir) found in --with-target-bdw-gc" "$LINENO" 5
+      fi
+      bdw_inc_dir="$bdw_val/include"
+      bdw_lib_dir="$bdw_val/lib"
+    fi
+    bdw_val=
+    if test "x$with_target_bdw_gc_include" != x; then
+      for i in `echo $with_target_bdw_gc_include | tr ',' ' '`; do
+        case "$i" in
+          *=*) sd=${i%%=*}; d=${i#*=} ;;
+          *) sd=.; d=$i; fallback=$i ;;
+        esac
+        if test "$mldir" = "$sd"; then
+          bdw_val=$d
+        fi
+      done
+      if test "x$bdw_val" = x && test "x$bdw_inc_dir" = x && test "x$fallback" != x; then
+        bdw_inc_dir="$fallback"
+      elif test "x$bdw_val" = x; then
+        as_fn_error $? "no multilib path ($mldir) found in --with-target-bdw-gc-include" "$LINENO" 5
+      else
+        bdw_inc_dir="$bdw_val"
+      fi
+    fi
+    bdw_val=
+    if test "x$with_target_bdw_gc_lib" != x; then
+      for i in `echo $with_target_bdw_gc_lib | tr ',' ' '`; do
+        case "$i" in
+          *=*) sd=${i%%=*}; d=${i#*=} ;;
+          *) sd=.; d=$i ;;
+        esac
+        if test "$mldir" = "$sd"; then
+          bdw_val=$d
+        fi
+      done
+      if test "x$bdw_val" = x; then
+        as_fn_error $? "no multilib path ($mldir) found in --with-target-bdw-gc-lib" "$LINENO" 5
+      fi
+      bdw_lib_dir="$bdw_val"
+    fi
+    if test "x$bdw_inc_dir" = x; then
+      as_fn_error $? "no multilib path ($mldir) found in --with-target-bdw-gc-include" "$LINENO" 5
+    fi
+    if test "x$bdw_lib_dir" = x; then
+      as_fn_error $? "no multilib path ($mldir) found in --with-target-bdw-gc-lib" "$LINENO" 5
+    fi
+    BDW_GC_CFLAGS="-I$bdw_inc_dir"
+    if test -f $bdw_lib_dir/libgc.la; then
+      BDW_GC_LIBS="$bdw_lib_dir/libgc.la"
+    else
+      BDW_GC_LIBS="-L$bdw_lib_dir -lgc"
+    fi
+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5
+$as_echo "found" >&6; }
+  fi
+
+  case "$BDW_GC_LIBS" in
+  *libgc.la)
+    use_bdw_gc=yes
+    ;;
+  *)
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for system boehm-gc" >&5
+$as_echo_n "checking for system boehm-gc... " >&6; }
+    save_CFLAGS=$CFLAGS
+    save_LIBS=$LIBS
+    CFLAGS="$CFLAGS $BDW_GC_CFLAGS"
+    LIBS="$LIBS $BDW_GC_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.  */
+#include <gc/gc.h>
+int
+main ()
+{
+GC_init()
+  ;
+  return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+
+        if test "$cross_compiling" = yes; then :
+            system_bdw_gc_found=no
+
+else
+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h.  */
+
+          #include <gc/gc.h>
+          int main() {
+            GC_init();
+            return 0;
+          }
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+  system_bdw_gc_found=yes
+else
+  system_bdw_gc_found=no
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+  conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+
+else
+  system_bdw_gc_found=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+    conftest$ac_exeext conftest.$ac_ext
+    CFLAGS=$save_CFLAGS
+    LIBS=$save_LIBS
+    if test x$enable_algol68_gc = xauto && test x$system_bdw_gc_found = xno; then
+      { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: system bdw-gc not found, building libga68 with no GC support" >&5
+$as_echo "$as_me: WARNING: system bdw-gc not found, building libga68 with no GC support" >&2;}
+      use_bdw_gc=no
+    elif test x$enable_algol68_gc = xyes && test x$system_bdw_gc_found = xno; then
+      as_fn_error $? "system bdw-gc required but not found" "$LINENO" 5
+    else
+      use_bdw_gc=yes
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5
+$as_echo "found" >&6; }
+    fi
+  esac
+esac
+
+if test "$use_bdw_gc" = no; then
+  LIBGA68_GCFLAGS=''
+  LIBGA68_BOEHM_GC_INCLUDES=''
+  LIBGA68_BOEHM_GC_LIBS=''
+else
+  LIBGA68_GCFLAGS='-DLIBGA68_WITH_GC=1'
+  LIBGA68_BOEHM_GC_INCLUDES=$BDW_GC_CFLAGS
+  LIBGA68_BOEHM_GC_LIBS=$BDW_GC_LIBS
+  SPEC_LIBGA68_DEPS="$SPEC_LIBGA68_DEPS $BDW_GC_LIBS"
+fi
+
+# Determine what GCC version number to use in filesystem paths.
+
+  get_gcc_base_ver="cat"
+
+# Check whether --with-gcc-major-version-only was given.
+if test "${with_gcc_major_version_only+set}" = set; then :
+  withval=$with_gcc_major_version_only; if test x$with_gcc_major_version_only = xyes ; then
+        get_gcc_base_ver="sed -e 's/^\([0-9]*\).*/\1/'"
+      fi
+
+fi
+
+
+
+
+extra_darwin_ldflags_libga68=
+case $host in
+  *-*-darwin*)
+     extra_darwin_ldflags_libga68=-Wl,-U,___algol68_main
+     if test -f $bdw_lib_dir/libgc.a; then
+       # Darwin wants to link this statically into the library
+       LIBGA68_BOEHM_GC_LIBS="$bdw_lib_dir/libgc.a"
+       # No spec entry.
+       BDW_GC_LIBS=
+     fi
+     ;;
+  *) ;;
+esac
+
+
+
+
+
+
+
+ac_config_files="$ac_config_files Makefile"
+
+ac_config_files="$ac_config_files libga68.spec"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: libga68 has been configured." >&5
+$as_echo "$as_me: libga68 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 "${ENABLE_DARWIN_AT_RPATH_TRUE}" && test -z "${ENABLE_DARWIN_AT_RPATH_FALSE}"; then
+  as_fn_error $? "conditional \"ENABLE_DARWIN_AT_RPATH\" 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" ;;
+    "libga68.spec") CONFIG_FILES="$CONFIG_FILES libga68.spec" ;;
+
+  *) 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
+
--- /dev/null
+++ b/src/libga68/configure.ac
@@ -0,0 +1,420 @@
+# Configure script for libga68.
+# Copyright (C) 2025 Jose E. Marchesi.
+
+# 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,,libga68)
+AC_CONFIG_SRCDIR(Makefile.am)
+AC_CONFIG_HEADER(config.h)
+
+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)
+
+if test "$build" != "$host"; then
+  # We are being configured with some form of cross compiler.
+  GLIBCXX_IS_NATIVE=false
+  case "$host","$target" in
+    # Darwin crosses can use the host system's libraries and headers,
+    # because of the fat library support.  Of course, it must be the
+    # same version of Darwin on both sides.  Allow the user to
+    # just say --target=foo-darwin without a version number to mean
+    # "the version on this system".
+      *-*-darwin*,*-*-darwin*)
+	hostos=`echo $host | sed 's/.*-darwin/darwin/'`
+	targetos=`echo $target | sed 's/.*-darwin/darwin/'`
+	if test $hostos = $targetos || test $targetos = darwin ; then
+	  GLIBCXX_IS_NATIVE=true
+	fi
+	;;
+
+      *)
+	GCC_NO_EXECUTABLES
+	;;
+  esac
+else
+  GLIBCXX_IS_NATIVE=true
+fi
+
+# Runs configure.host, and assorted other critical bits.  Sets
+# up critical shell variables.
+GLIBCXX_CONFIGURE
+
+AM_INIT_AUTOMAKE([1.15.1 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_CHECK_HEADERS(malloc.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_PROG_MAKE_SET
+AC_PROG_INSTALL
+
+AM_PROG_LIBTOOL
+LT_INIT
+AC_LIBTOOL_DLOPEN
+
+AM_CONDITIONAL([ENABLE_DARWIN_AT_RPATH], [test x$enable_darwin_at_rpath = xyes])
+
+AC_SUBST(enable_shared)
+AC_SUBST(enable_static)
+
+if test "${multilib}" = "yes"; then
+  multilib_arg="--enable-multilib"
+else
+  multilib_arg=
+fi
+
+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)
+
+CC_FOR_BUILD=${CC_FOR_BUILD:-gcc}
+AC_SUBST(CC_FOR_BUILD)
+
+AC_SEARCH_LIBS([malloc], [c])
+AC_SEARCH_LIBS([cosf], [m])
+AC_SEARCH_LIBS([clock_gettime], [rt])
+
+# Add dependencies for libga68.spec file
+SPEC_LIBGA68_DEPS="$LIBS"
+AC_SUBST(SPEC_LIBGA68_DEPS)
+
+# libga68 soname version
+libga68_VERSION=1:0:0
+AC_SUBST(libga68_VERSION)
+
+# The Boehm GC
+
+AC_ARG_ENABLE(algol68-gc,
+[AS_HELP_STRING([--enable-algol68-gc],
+		[enable use of Boehm's garbage collector with the
+		 GNU Algol runtime])],,enable_algol68_gc=no)
+AC_ARG_WITH([target-bdw-gc],
+[AS_HELP_STRING([--with-target-bdw-gc=PATHLIST],
+		[specify prefix directory for installed bdw-gc package.
+		 Equivalent to --with-target-bdw-gc-include=PATH/include
+		 plus --with-target-bdw-gc-lib=PATH/lib])])
+AC_ARG_WITH([target-bdw-gc-include],
+[AS_HELP_STRING([--with-target-bdw-gc-include=PATHLIST],
+		[specify directories for installed bdw-gc include files])])
+AC_ARG_WITH([target-bdw-gc-lib],
+[AS_HELP_STRING([--with-target-bdw-gc-lib=PATHLIST],
+		[specify directories for installed bdw-gc library])])
+
+bdw_lib_dir=
+case "$enable_algol68_gc" in
+no)
+  use_bdw_gc=no
+  ;;
+*)
+  AC_MSG_CHECKING([for bdw garbage collector])
+  if test "x$with_target_bdw_gc$with_target_bdw_gc_include$with_target_bdw_gc_lib" = x; then
+    dnl no bdw-gw options, assuming bdw-gc in default locations
+    BDW_GC_CFLAGS=
+    BDW_GC_LIBS="-lgc"
+  else
+    dnl bdw-gw options passed by configure flags
+    if test "x$with_target_bdw_gc_include" = x && test "x$with_target_bdw_gc_lib" != x; then
+      AC_MSG_ERROR([found --with-target-bdw-gc-lib but --with-target-bdw-gc-include missing])
+    elif test "x$with_target_bdw_gc_include" != x && test "x$with_target_bdw_gc_lib" = x; then
+      AC_MSG_ERROR([found --with-target-bdw-gc-include but --with-target-bdw-gc-lib missing])
+    else
+      AC_MSG_RESULT([using paths configured with --with-target-bdw-gc options])
+    fi
+    mldir=`${CC-gcc} --print-multi-directory 2>/dev/null`
+    bdw_val=
+    if test "x$with_target_bdw_gc" != x; then
+      for i in `echo $with_target_bdw_gc | tr ',' ' '`; do
+        case "$i" in
+          *=*) sd=${i%%=*}; d=${i#*=} ;;
+          *) sd=.; d=$i ;;
+        esac
+        if test "$mldir" = "$sd"; then
+          bdw_val=$d
+        fi
+      done
+      if test "x$bdw_val" = x; then
+        AC_MSG_ERROR([no multilib path ($mldir) found in --with-target-bdw-gc])
+      fi
+      bdw_inc_dir="$bdw_val/include"
+      bdw_lib_dir="$bdw_val/lib"
+    fi
+    bdw_val=
+    if test "x$with_target_bdw_gc_include" != x; then
+      for i in `echo $with_target_bdw_gc_include | tr ',' ' '`; do
+        case "$i" in
+          *=*) sd=${i%%=*}; d=${i#*=} ;;
+          *) sd=.; d=$i; fallback=$i ;;
+        esac
+        if test "$mldir" = "$sd"; then
+          bdw_val=$d
+        fi
+      done
+      if test "x$bdw_val" = x && test "x$bdw_inc_dir" = x && test "x$fallback" != x; then
+        bdw_inc_dir="$fallback"
+      elif test "x$bdw_val" = x; then
+        AC_MSG_ERROR([no multilib path ($mldir) found in --with-target-bdw-gc-include])
+      else
+        bdw_inc_dir="$bdw_val"
+      fi
+    fi
+    bdw_val=
+    if test "x$with_target_bdw_gc_lib" != x; then
+      for i in `echo $with_target_bdw_gc_lib | tr ',' ' '`; do
+        case "$i" in
+          *=*) sd=${i%%=*}; d=${i#*=} ;;
+          *) sd=.; d=$i ;;
+        esac
+        if test "$mldir" = "$sd"; then
+          bdw_val=$d
+        fi
+      done
+      if test "x$bdw_val" = x; then
+        AC_MSG_ERROR([no multilib path ($mldir) found in --with-target-bdw-gc-lib])
+      fi
+      bdw_lib_dir="$bdw_val"
+    fi
+    if test "x$bdw_inc_dir" = x; then
+      AC_MSG_ERROR([no multilib path ($mldir) found in --with-target-bdw-gc-include])
+    fi
+    if test "x$bdw_lib_dir" = x; then
+      AC_MSG_ERROR([no multilib path ($mldir) found in --with-target-bdw-gc-lib])
+    fi
+    BDW_GC_CFLAGS="-I$bdw_inc_dir"
+    if test -f $bdw_lib_dir/libgc.la; then
+      BDW_GC_LIBS="$bdw_lib_dir/libgc.la"
+    else
+      BDW_GC_LIBS="-L$bdw_lib_dir -lgc"
+    fi
+    AC_MSG_RESULT([found])
+  fi
+
+  case "$BDW_GC_LIBS" in
+  *libgc.la)
+    use_bdw_gc=yes
+    ;;
+  *)
+    AC_MSG_CHECKING([for system boehm-gc])
+    save_CFLAGS=$CFLAGS
+    save_LIBS=$LIBS
+    CFLAGS="$CFLAGS $BDW_GC_CFLAGS"
+    LIBS="$LIBS $BDW_GC_LIBS"
+    dnl the link test is not good enough for ARM32 multilib detection,
+    dnl first check to link, then to run
+    AC_LINK_IFELSE(
+      [AC_LANG_PROGRAM([#include <gc/gc.h>],[GC_init()])],
+      [
+        AC_RUN_IFELSE([AC_LANG_SOURCE([[
+          #include <gc/gc.h>
+          int main() {
+            GC_init();
+            return 0;
+          }
+          ]])],
+          [system_bdw_gc_found=yes],
+          [system_bdw_gc_found=no],
+          dnl assume no system boehm-gc for cross builds ...
+          [system_bdw_gc_found=no]
+        )
+      ],
+      [system_bdw_gc_found=no])
+    CFLAGS=$save_CFLAGS
+    LIBS=$save_LIBS
+    if test x$enable_algol68_gc = xauto && test x$system_bdw_gc_found = xno; then
+      AC_MSG_WARN([system bdw-gc not found, building libga68 with no GC support])
+      use_bdw_gc=no
+    elif test x$enable_algol68_gc = xyes && test x$system_bdw_gc_found = xno; then
+      AC_MSG_ERROR([system bdw-gc required but not found])
+    else
+      use_bdw_gc=yes
+      AC_MSG_RESULT([found])
+    fi
+  esac
+esac
+
+if test "$use_bdw_gc" = no; then
+  LIBGA68_GCFLAGS=''
+  LIBGA68_BOEHM_GC_INCLUDES=''
+  LIBGA68_BOEHM_GC_LIBS=''
+else
+  LIBGA68_GCFLAGS='-DLIBGA68_WITH_GC=1'
+  LIBGA68_BOEHM_GC_INCLUDES=$BDW_GC_CFLAGS
+  LIBGA68_BOEHM_GC_LIBS=$BDW_GC_LIBS
+  SPEC_LIBGA68_DEPS="$SPEC_LIBGA68_DEPS $BDW_GC_LIBS"
+fi
+
+# Determine what GCC version number to use in filesystem paths.
+GCC_BASE_VER
+
+extra_darwin_ldflags_libga68=
+case $host in
+  *-*-darwin*)
+     extra_darwin_ldflags_libga68=-Wl,-U,___algol68_main
+     if test -f $bdw_lib_dir/libgc.a; then
+       # Darwin wants to link this statically into the library
+       LIBGA68_BOEHM_GC_LIBS="$bdw_lib_dir/libgc.a"
+       # No spec entry.
+       BDW_GC_LIBS=
+     fi
+     ;;
+  *) ;;
+esac
+AC_SUBST(extra_darwin_ldflags_libga68)
+
+AC_SUBST(LIBGA68_GCFLAGS)
+AC_SUBST(LIBGA68_BOEHM_GC_INCLUDES)
+AC_SUBST(LIBGA68_BOEHM_GC_LIBS)
+
+AC_CONFIG_SRCDIR([Makefile.am])
+AC_CONFIG_FILES([Makefile])
+AC_CONFIG_FILES(libga68.spec)
+
+AC_MSG_NOTICE([libga68 has been configured.])
+
+AC_OUTPUT
--- /dev/null
+++ b/src/libga68/ga68-alloc.c
@@ -0,0 +1,111 @@
+/* Run-time routines for memory allocation.
+
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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.
+
+   Under Section 7 of GPL version 3, you are granted additional permissions
+   described in the GCC Runtime Library Exception, version 3.1, as published by
+   the Free Software Foundation.
+
+   You should have received a copy of the GNU General Public License and a copy
+   of the 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 <stdlib.h>
+
+#include "ga68.h"
+
+/* Heap allocation routines.  */
+
+#if LIBGA68_WITH_GC
+#include <gc/gc.h>
+
+void
+_libga68_init_heap (void)
+{
+  if (!GC_is_init_called ())
+    {
+      GC_INIT ();
+      /*      GC_allow_register_threads (); */
+    }
+}
+
+void *
+_libga68_realloc (void *ptr, size_t size)
+{
+  void *res = (void *) GC_realloc (ptr, size);
+  if (!res)
+    _libga68_abort ("Virtual memory exhausted\n");
+  return res;
+}
+
+void *
+_libga68_realloc_unchecked (void *ptr, size_t size)
+{
+  void *res = (void *) GC_realloc (ptr, size);
+  return res;
+}
+
+void *
+_libga68_malloc (size_t size)
+{
+  void *res = (void *) GC_malloc (size);
+  if (!res)
+    _libga68_abort ("Virtual memory exhausted\n");
+  return res;
+}
+
+void
+_libga68_free (void *pt)
+{
+  GC_free (pt);
+}
+
+#else
+
+void
+_libga68_init_heap (void)
+{
+}
+
+void *
+_libga68_realloc (void *ptr, size_t size)
+{
+  void *res = (void *) realloc (ptr, size);
+  if (!res)
+    _libga68_abort ("Virtual memory exhausted\n");
+  return res;
+}
+
+void *
+_libga68_realloc_unchecked (void *ptr, size_t size)
+{
+  void *res = (void *) realloc (ptr, size);
+  return res;
+}
+
+void *
+_libga68_malloc (size_t size)
+{
+  void *res = (void *) malloc (size);
+  if (!res)
+    _libga68_abort ("Virtual memory exhausted\n");
+  return res;
+}
+
+void
+_libga68_free (void *pt)
+{
+  free (pt);
+}
+
+#endif /* !LIBGA68_WITH_GC */
--- /dev/null
+++ b/src/libga68/ga68-error.c
@@ -0,0 +1,151 @@
+/* Support run-time routines for error handling.
+
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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.
+
+   Under Section 7 of GPL version 3, you are granted additional permissions
+   described in the GCC Runtime Library Exception, version 3.1, as published by
+   the Free Software Foundation.
+
+   You should have received a copy of the GNU General Public License and a copy
+   of the 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 <stdlib.h> /* For abort.  */
+
+#include "ga68.h"
+
+/* Run-time error handling.
+
+   Please use the following format when outputing runtime error messages:
+
+     FILE:LINE:[COLUMN:] TEXT
+
+   This keeps the output aligned with other runtime libraries such as the
+   sanitizers.  */
+
+/* Emit a formatted error message to the standard output and then terminate the
+   process with an error code.  */
+
+void
+_libga68_abort (const char *fmt, ...)
+{
+  va_list ap;
+
+  va_start (ap, fmt);
+  vfprintf (stderr, fmt, ap);
+  abort ();
+  va_end (ap);
+}
+
+/* Assertion failure.  */
+
+void
+_libga68_assert (const char *filename, unsigned int lineno)
+{
+  _libga68_abort ("%s:%u: runtime error: ASSERT failure\n",
+		 filename, lineno);
+}
+
+/* Attempt to dereference NIL failure.  */
+
+void
+_libga68_derefnil (const char *filename, unsigned int lineno)
+{
+  _libga68_abort ("%s:%d: runtime error: attempt to dereference NIL\n",
+		  filename, lineno);
+}
+
+/* Invalid character expression.  */
+
+void
+_libga68_invalidcharerror (const char *filename, unsigned int lineno,
+			   int c)
+{
+  if (c < 0)
+    _libga68_abort ("%s:%d: runtime error: %d is not a valid character point\n",
+		    filename, lineno, c);
+  _libga68_abort ("%s:%d: runtime error: U+%x is not a valid character point\n",
+		  filename, lineno, c);
+}
+
+/* Out of bounds error in bits ELEM operator.  */
+
+void
+_libga68_bitsboundserror (const char *filename, unsigned int lineno,
+			  ssize_t pos)
+{
+  _libga68_abort ("%s:%d: runtime error: bound %d out of range in ELEM\n",
+		  filename, lineno, pos);
+}
+
+/* Unreachable error.  */
+
+void
+_libga68_unreachable (const char *filename, unsigned int lineno)
+{
+  _libga68_abort ("%s:%d: runtime error: unreachable reached\n",
+		  filename, lineno);
+}
+
+/* Lower bound failure.  */
+
+void
+_libga68_lower_bound (const char *filename, unsigned int lineno,
+			   ssize_t index, ssize_t lower_bound)
+{
+  _libga68_abort ("%s:%d: runtime error: lower bound %d must be >= %d\n",
+		  filename, lineno, index, lower_bound);
+}
+
+/* Upper bound failure.  */
+
+void
+_libga68_upper_bound (const char *filename, unsigned int lineno,
+			   ssize_t index, ssize_t upper_bound)
+{
+  _libga68_abort ("%s:%d: runtime error: upper bound %d must be <= %d\n",
+		  filename, lineno, index, upper_bound);
+}
+
+/* Bounds failure.  */
+
+void
+_libga68_bounds (const char *filename, unsigned int lineno,
+		 ssize_t index, ssize_t lower_bound, ssize_t upper_bound)
+{
+  _libga68_abort ("%s:%d: runtime error: bound %d out of range [%d:%d]\n",
+		  filename, lineno, index, lower_bound, upper_bound);
+}
+
+/* Dimension failure.  */
+
+void
+_libga68_dim (const char *filename, unsigned int lineno,
+	      size_t dim, size_t index)
+{
+  _libga68_abort ("%s:%d: runtime error: invalid dimension %d; shall be > 0 and <= %d\n",
+		  filename, lineno, index, dim);
+}
+
+/* Multiples have different bounds in assignations.  */
+
+void
+_libga68_bounds_mismatch (const char *filename, unsigned int lineno,
+			  size_t dim, ssize_t lb1, ssize_t ub1,
+			  ssize_t lb2, ssize_t ub2)
+{
+  _libga68_abort ("%s:%d: runtime error: multiple bounds mismatch in \
+assignation: dim %d: [%d,%d] /= [%d,%d]\n",
+		  filename, lineno, dim, lb1, ub1, lb2, ub2);
+}
--- /dev/null
+++ b/src/libga68/ga68-posix.c
@@ -0,0 +1,403 @@
+/* Support run-time routines for the POSIX prelude.
+
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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.
+
+   Under Section 7 of GPL version 3, you are granted additional permissions
+   described in the GCC Runtime Library Exception, version 3.1, as published by
+   the Free Software Foundation.
+
+   You should have received a copy of the GNU General Public License and a copy
+   of the 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 <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <fcntl.h>  /* For open.  */
+#include <unistd.h> /* For close and write.  */
+#include <errno.h>  /* For errno.  */
+#include <sys/socket.h>
+#include <sys/stat.h> /* For struct stat */
+#include <netinet/in.h>
+#include <netdb.h> /* For gethostbyname.  */
+#include <limits.h> /* For LLONG_MAX */
+
+#include "ga68.h"
+
+/* Some Unicode code points used in this file.  */
+
+#define REPLACEMENT_CHARACTER 0xFFFD
+#define NEWLINE 0x000A
+
+/* Errno.  */
+
+static int _libga68_errno;
+
+/* Simple I/O based on POSIX file descriptors.  */
+
+int
+_libga68_posixerrno (void)
+{
+  return _libga68_errno;
+}
+
+void
+_libga68_posixperror (uint32_t *s, size_t len, size_t stride)
+{
+  size_t u8len;
+  uint8_t *u8str = _libga68_u32_to_u8 (s, len, stride, NULL, &u8len);
+
+  const char *errstr = strerror (_libga68_errno);
+  (void) write (2, u8str, u8len);
+  (void) write (2, ": ", 2);
+  (void) write (2, errstr, strlen (errstr));
+  (void) write (2, "\n", 1);
+}
+
+uint32_t *
+_libga68_posixstrerror (int errnum, size_t *len)
+{
+  char *str = strerror (_libga68_errno);
+  return _libga68_u8_to_u32 (str, strlen (str), NULL, len);
+}
+
+#define FILE_O_DEFAULT 0x0
+#define FILE_O_RDONLY  0x1
+#define FILE_O_WRONLY  0x2
+#define FILE_O_RDWR    0x3
+#define FILE_O_TRUNC   0x4
+
+int
+_libga68_posixfopen (uint32_t *pathname, size_t len, size_t stride,
+		     unsigned int flags)
+{
+  int openflags = 0;
+  size_t u8len;
+  uint8_t *u8pathname = _libga68_u32_to_u8 (pathname, len, stride, NULL, &u8len);
+
+  if (flags & FILE_O_RDONLY)
+    openflags |= O_RDONLY;
+  if (flags & FILE_O_WRONLY)
+    openflags |= O_WRONLY;
+  if (flags & FILE_O_RDWR)
+    openflags |= O_RDWR;
+  if (flags & FILE_O_TRUNC)
+    openflags |= O_TRUNC;
+
+  char *filepath = _libga68_malloc (u8len + 1);
+  memcpy (filepath, u8pathname, u8len);
+  filepath[u8len] = '\0';
+  int fd = open (filepath, openflags);
+  _libga68_errno = errno;
+  _libga68_free (filepath);
+  return fd;
+}
+
+int
+_libga68_posixcreat (uint32_t *pathname, size_t len, size_t stride,
+		     uint32_t mode)
+{
+  size_t u8len;
+  uint8_t *u8pathname = _libga68_u32_to_u8 (pathname, len, stride, NULL, &u8len);
+  u8pathname[u8len] = '\0';
+
+  int res = creat (u8pathname, mode);
+  _libga68_errno = errno;
+  return res;
+}
+
+int
+_libga68_posixclose (int fd)
+{
+  int res = close (fd);
+  _libga68_errno = errno;
+  return res;
+}
+
+/* Implementation of the posix prelude `posix argc'.  */
+
+int
+_libga68_posixargc (void)
+{
+  return _libga68_argc;
+}
+
+/* Implementation of the posix prelude `posix argv'.  */
+
+uint32_t *
+_libga68_posixargv (int n, size_t *len)
+{
+  if (n < 0 || n > _libga68_argc)
+    {
+      /* Return an empty string.  */
+      *len = 0;
+      return NULL;
+    }
+  else
+    {
+      char *arg = _libga68_argv[n - 1];
+      return _libga68_u8_to_u32 (arg, strlen (arg), NULL, len);
+    }
+}
+
+/* Implementation of the posix prelude `posix getenv'.  */
+
+void
+_libga68_posixgetenv (uint32_t *s, size_t len, size_t stride,
+		      uint32_t **r, size_t *rlen)
+{
+  size_t varlen;
+  char *varname = _libga68_u32_to_u8 (s, len, stride, NULL, &varlen);
+
+  char *var = _libga68_malloc (varlen + 1);
+  memcpy (var, varname, varlen);
+  var[varlen] = '\0';
+  char *val = getenv (var);
+  _libga68_free (var);
+
+  if (val == NULL)
+    {
+      /* Return an empty string.  */
+      *r = NULL;
+      *rlen = 0;
+    }
+  else
+    *r = _libga68_u8_to_u32 (val, strlen (val), NULL, rlen);
+}
+
+/* Implementation of the posix prelude `posix puts'.  */
+
+void
+_libga68_posixputs (uint32_t *s, size_t len, size_t stride)
+{
+  (void) _libga68_posixfputs (1, s, len, stride);
+}
+
+/* Implementation of the posix prelude `posix fputs'.  */
+
+int
+_libga68_posixfputs (int fd, uint32_t *s, size_t len, size_t stride)
+{
+  size_t u8len;
+  uint8_t *u8str = _libga68_u32_to_u8 (s, len, stride, NULL, &u8len);
+
+  ssize_t ret = write (fd, u8str, u8len);
+  _libga68_errno = errno;
+  if (ret == -1)
+    return 0;
+  else
+    return u8len;
+}
+
+/* Implementation of the posix prelude `posix putc'.  */
+
+uint32_t
+_libga68_posixfputc (int fd, uint32_t c)
+{
+  uint8_t u8[6];
+
+  int u8len = _libga68_u8_uctomb (u8, c, 6);
+  if (u8len < 0)
+    return REPLACEMENT_CHARACTER;
+
+  ssize_t ret = write (fd, &u8, u8len);
+  if (ret == -1)
+    return REPLACEMENT_CHARACTER;
+  else
+    return c;
+}
+
+/* Implementation of the posix prelude `posix putchar'.  */
+
+uint32_t
+_libga68_posixputchar (uint32_t c)
+{
+  return _libga68_posixfputc (1, c);
+}
+
+/* Implementation of the posix prelude `posix fgetc'.  */
+
+uint32_t
+_libga68_posixfgetc (int fd)
+{
+  /* We need to read one char (byte) at a time from FD, until we complete a
+     full Unicode character.  Then we convert to UCS-4.  */
+
+  uint8_t c;
+  uint8_t u8c[6];
+  size_t morechars = 0;
+  size_t i;
+
+  /* Read first UTF-8 character.  This gives us the total length of the
+     character.  */
+  if (read (fd, &c, 1) != 1)
+    return REPLACEMENT_CHARACTER;
+
+  if (c < 128)
+    morechars = 0;
+  else if (c < 224)
+    morechars = 1;
+  else if (c < 240)
+    morechars = 2;
+  else
+    morechars = 3;
+
+  u8c[0] = c;
+  for (i = 0; i < morechars; ++i)
+    {
+      if (read (fd, &c, 1) != 1)
+	return REPLACEMENT_CHARACTER;
+      u8c[i + 1] = c;
+    }
+
+  uint32_t res;
+  int length = _libga68_u8_mbtouc (&res, (const uint8_t *) &u8c, 1);
+  if (res == REPLACEMENT_CHARACTER || length != 1)
+    return REPLACEMENT_CHARACTER;
+  else
+    return res;
+}
+
+/* Implementation of the posix prelude `posix getchar'.  */
+
+uint32_t
+_libga68_posixgetchar (void)
+{
+  return _libga68_posixfgetc (0);
+}
+
+/* Implementation of the posix prelude `posix fgets'.  */
+
+uint32_t *
+_libga68_posixfgets (int fd, int nchars, size_t *len)
+{
+  uint32_t *res = NULL;
+  int n = 0;
+  uint32_t uc;
+
+  if (nchars > 0)
+    {
+      /* Read exactly nchar or until EOF.  */
+      res = _libga68_malloc (nchars * sizeof (uint32_t));
+      do
+	{
+	  uc = _libga68_posixfgetc (fd);
+	  if (uc == REPLACEMENT_CHARACTER)
+	    break;
+	  res[n++] = uc;
+	}
+      while (n < nchars);
+    }
+  else
+    {
+      /* Read until newline or EOF.  */
+      size_t allocated = 80 * sizeof (uint32_t);
+      res = _libga68_malloc (allocated);
+      do
+	{
+	  uc = _libga68_posixfgetc (fd);
+	  if (uc != REPLACEMENT_CHARACTER)
+	    {
+	      if (n % 80 == 0)
+		res = _libga68_realloc (res, n * 80 * sizeof (uint32_t) + 80 * sizeof (uint32_t));
+	      res[n++] = uc;
+	    }
+	}
+      while (uc != NEWLINE && uc != REPLACEMENT_CHARACTER);
+      if (n > 0)
+	res = _libga68_realloc (res, n * 80 * sizeof (uint32_t));
+    }
+
+  *len = n;
+  return res;
+}
+
+/* Implementation of the posix prelude `posix gets'.  */
+
+uint32_t *
+_libga68_posixgets (int nchars, size_t *len)
+{
+  return _libga68_posixfgets (0, nchars, len);
+}
+
+/* Implementation of the posix prelude `fconnect'.  */
+
+int
+_libga68_posixfconnect (uint32_t *str, size_t len, size_t stride,
+			int port)
+{
+  size_t u8len;
+  uint8_t *u8host = _libga68_u32_to_u8 (str, len, stride, NULL, &u8len);
+
+  /* Create a stream socket.  */
+  int fd = socket (AF_INET, SOCK_STREAM, 0);
+  _libga68_errno = errno;
+  if (fd < 0)
+    goto error;
+
+  /* Lookup the specified host.  */
+  char *host = _libga68_malloc (u8len + 1);
+  memcpy (host, u8host, u8len);
+  host[u8len] = '\0';
+  struct hostent *server = gethostbyname (host);
+  if (server == NULL)
+    {
+      _libga68_errno = h_errno;
+      goto close_fd_and_error;
+    }
+
+  /* Connect the socket to the server.  */
+  struct sockaddr_in serv_addr;
+  memset (&serv_addr, 0, sizeof (serv_addr));
+  serv_addr.sin_family = AF_INET;
+  serv_addr.sin_port = htons (port);
+  memcpy (&serv_addr.sin_addr.s_addr,
+	  server->h_addr,
+	  server->h_length);
+  int res = connect (fd, (struct sockaddr *) &serv_addr,
+		     sizeof (serv_addr));
+  _libga68_errno = errno;
+  if (res == -1)
+    goto close_fd_and_error;
+
+  _libga68_free (host);
+  return fd;
+
+ close_fd_and_error:
+  close (fd);
+ error:
+  _libga68_free (host);
+  return -1;
+}
+
+/* Implementation of the posix prelude `fsize'.  */
+
+long long int
+_libga68_posixfsize (int fd)
+{
+  struct stat stat;
+
+  if (fstat (fd, &stat) == -1)
+    {
+      _libga68_errno = errno;
+      return -1;
+    }
+
+  if (stat.st_size > LLONG_MAX)
+    {
+      _libga68_errno = EOVERFLOW;
+      return -1;
+    }
+
+  return (long int) stat.st_size;
+}
--- /dev/null
+++ b/src/libga68/ga68-standenv.c
@@ -0,0 +1,48 @@
+/* Support run-time routines for the standard prelude.
+
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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.
+
+   Under Section 7 of GPL version 3, you are granted additional permissions
+   described in the GCC Runtime Library Exception, version 3.1, as published by
+   the Free Software Foundation.
+
+   You should have received a copy of the GNU General Public License and a copy
+   of the 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 <stdlib.h> /* For rand.  */
+
+#include "ga68.h"
+
+/* Implementation of the standard prelude `random' function.  */
+
+float
+_libga68_random (void)
+{
+  float res = (float) rand () / (float) (RAND_MAX);
+  return res;
+}
+
+double
+_libga68_longrandom (void)
+{
+  double res = (double) rand () / (float) (RAND_MAX);
+  return res;
+}
+
+long double
+_libga68_longlongrandom (void)
+{
+  long double res = (long double) rand () / (float) (RAND_MAX);
+  return res;
+}
--- /dev/null
+++ b/src/libga68/ga68-unistr.c
@@ -0,0 +1,615 @@
+/* libga68 unicode support routines.
+   Copyright (C) 2009-2025 Free Software Foundation, Inc.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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.
+
+   Under Section 7 of GPL version 3, you are granted additional permissions
+   described in the GCC Runtime Library Exception, version 3.1, as published by
+   the Free Software Foundation.
+
+   You should have received a copy of the GNU General Public License and a copy
+   of the GCC Runtime Library Exception along with this program; see the files
+   COPYING3 and COPYING.RUNTIME respectively.  If not, see
+   <http://www.gnu.org/licenses/>.  */
+
+/* The code in this file has been copied from the unistr gnulib module, written
+   by Bruno Haible, and adapted to support strides.  */
+
+#include <stddef.h> /* For ptrdiff_t */
+#include <stdlib.h>
+#include <stdint.h>
+#include <errno.h>
+#include <string.h>
+
+#include "ga68.h"
+
+/* CMP (n1, n2) performs a three-valued comparison on n1 vs. n2, where
+   n1 and n2 are expressions without side effects, that evaluate to real
+   numbers (excluding NaN).
+   It returns
+     1  if n1 > n2
+     0  if n1 == n2
+     -1 if n1 < n2
+   The naïve code   (n1 > n2 ? 1 : n1 < n2 ? -1 : 0)  produces a conditional
+   jump with nearly all GCC versions up to GCC 10.
+   This variant     (n1 < n2 ? -1 : n1 > n2)  produces a conditional with many
+   GCC versions up to GCC 9.
+   The better code  (n1 > n2) - (n1 < n2)  from Hacker's Delight § 2-9
+   avoids conditional jumps in all GCC versions >= 3.4.  */
+
+#define CMP(n1, n2) (((n1) > (n2)) - ((n1) < (n2)))
+
+/* MIN(a,b) returns the minimum of A and B.  */
+
+#ifndef MIN
+# define MIN(a,b) ((a) < (b) ? (a) : (b))
+#endif
+
+/* Compare two UCS-4 strings of same lenght, lexicographically.
+   Return -1, 0 or 1.  */
+
+int
+_libga68_u32_cmp (const uint32_t *s1, size_t stride1,
+		  const uint32_t *s2, size_t stride2,
+		  size_t n)
+{
+  stride1 = stride1 / sizeof (uint32_t);
+  stride2 = stride2 / sizeof (uint32_t);
+  
+  for (; n > 0;)
+    {
+      uint32_t uc1 = *s1;
+      s1 += stride1;
+      uint32_t uc2 = *s2;
+      s2 += stride2;
+      if (uc1 == uc2)
+        {
+          n--;
+          continue;
+        }
+      /* Note that uc1 and uc2 each have at most 31 bits. */
+      return (int)uc1 - (int)uc2;
+      /* > 0 if uc1 > uc2, < 0 if uc1 < uc2. */
+    }
+  return 0;
+}
+
+/* Compare two UCS-4 strings of perhaps different lenghts, lexicographically.
+   Return -1, 0 or 1.  */
+
+int
+_libga68_u32_cmp2 (const uint32_t *s1, size_t n1, size_t stride1,
+		   const uint32_t *s2, size_t n2, size_t stride2)
+{
+  int cmp = _libga68_u32_cmp (s1, stride1, s2, stride2, MIN (n1, n2));
+
+  if (cmp == 0)
+    cmp = CMP (n1, n2);
+
+  return cmp;
+}
+
+/* Get the UCS code for the first character of a given UTF-8 string.  */
+
+int
+_libga68_u8_mbtouc (uint32_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+        {
+          if (n >= 2)
+            {
+              if ((s[1] ^ 0x80) < 0x40)
+                {
+                  *puc = ((unsigned int) (c & 0x1f) << 6)
+                         | (unsigned int) (s[1] ^ 0x80);
+                  return 2;
+                }
+              /* invalid multibyte character */
+            }
+          else
+            {
+              /* incomplete multibyte character */
+              *puc = 0xfffd;
+              return 1;
+            }
+        }
+      else if (c < 0xf0)
+        {
+          if (n >= 3)
+            {
+              if ((s[1] ^ 0x80) < 0x40
+                  && (c >= 0xe1 || s[1] >= 0xa0)
+                  && (c != 0xed || s[1] < 0xa0))
+                {
+                  if ((s[2] ^ 0x80) < 0x40)
+                    {
+                      *puc = ((unsigned int) (c & 0x0f) << 12)
+                             | ((unsigned int) (s[1] ^ 0x80) << 6)
+                             | (unsigned int) (s[2] ^ 0x80);
+                      return 3;
+                    }
+                  /* invalid multibyte character */
+                  *puc = 0xfffd;
+                  return 2;
+                }
+              /* invalid multibyte character */
+              *puc = 0xfffd;
+              return 1;
+            }
+          else
+            {
+              *puc = 0xfffd;
+              if (n == 1)
+                {
+                  /* incomplete multibyte character */
+                  return 1;
+                }
+              else
+                {
+                  if ((s[1] ^ 0x80) < 0x40
+                      && (c >= 0xe1 || s[1] >= 0xa0)
+                      && (c != 0xed || s[1] < 0xa0))
+                    {
+                      /* incomplete multibyte character */
+                      return 2;
+                    }
+                  else
+                    {
+                      /* invalid multibyte character */
+                      return 1;
+                    }
+                }
+            }
+        }
+      else if (c <= 0xf4)
+        {
+          if (n >= 4)
+            {
+              if ((s[1] ^ 0x80) < 0x40
+                  && (c >= 0xf1 || s[1] >= 0x90)
+                  && (c < 0xf4 || (/* c == 0xf4 && */ s[1] < 0x90)))
+                {
+                  if ((s[2] ^ 0x80) < 0x40)
+                    {
+                      if ((s[3] ^ 0x80) < 0x40)
+                        {
+                          *puc = ((unsigned int) (c & 0x07) << 18)
+                                 | ((unsigned int) (s[1] ^ 0x80) << 12)
+                                 | ((unsigned int) (s[2] ^ 0x80) << 6)
+                                 | (unsigned int) (s[3] ^ 0x80);
+                          return 4;
+                        }
+                      /* invalid multibyte character */
+                      *puc = 0xfffd;
+                      return 3;
+                    }
+                  /* invalid multibyte character */
+                  *puc = 0xfffd;
+                  return 2;
+                }
+              /* invalid multibyte character */
+              *puc = 0xfffd;
+              return 1;
+            }
+          else
+            {
+              *puc = 0xfffd;
+              if (n == 1)
+                {
+                  /* incomplete multibyte character */
+                  return 1;
+                }
+              else
+                {
+                  if ((s[1] ^ 0x80) < 0x40
+                      && (c >= 0xf1 || s[1] >= 0x90)
+                      && (c < 0xf4 || (/* c == 0xf4 && */ s[1] < 0x90)))
+                    {
+                      if (n == 2)
+                        {
+                          /* incomplete multibyte character */
+                          return 2;
+                        }
+                      else
+                        {
+                          if ((s[2] ^ 0x80) < 0x40)
+                            {
+                              /* incomplete multibyte character */
+                              return 3;
+                            }
+                          else
+                            {
+                              /* invalid multibyte character */
+                              return 2;
+                            }
+                        }
+                    }
+                  else
+                    {
+                      /* invalid multibyte character */
+                      return 1;
+                    }
+                }
+            }
+        }
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return 1;
+}
+
+/* Encode a given UCS code in UTF-8.  */
+
+int
+_libga68_u8_uctomb (uint8_t *s, uint32_t uc, ptrdiff_t n)
+{
+  if (uc < 0x80)
+    {
+      if (n > 0)
+        {
+          s[0] = uc;
+          return 1;
+        }
+      /* else return -2, below.  */
+    }
+  else
+    {
+      int count;
+
+      if (uc < 0x800)
+        count = 2;
+      else if (uc < 0x10000)
+        {
+          if (uc < 0xd800 || uc >= 0xe000)
+            count = 3;
+          else
+            return -1;
+        }
+      else if (uc < 0x110000)
+        count = 4;
+      else
+        return -1;
+
+      if (n >= count)
+        {
+          switch (count) /* note: code falls through cases! */
+            {
+            case 4: s[3] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x10000;
+              /* Fallthrough.  */
+            case 3: s[2] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x800;
+	      /* Fallthrough.  */
+            case 2: s[1] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0xc0;
+          /*case 1:*/ s[0] = uc;
+            }
+          return count;
+        }
+    }
+  return -2;
+}
+
+/* Convert UCS-4 to UTF-8  */
+
+uint8_t *
+_libga68_u32_to_u8 (const uint32_t *s, size_t n, size_t stride,
+		    uint8_t *resultbuf, size_t *lengthp)
+{
+  const uint32_t *s_end;
+  /* Output string accumulator.  */
+  uint8_t *result;
+  size_t allocated;
+  size_t length;
+
+  stride = stride / sizeof (uint32_t);
+  s_end = s + (n * stride);
+  
+  if (resultbuf != NULL)
+    {
+      result = resultbuf;
+      allocated = *lengthp;
+    }
+  else
+    {
+      result = NULL;
+      allocated = 0;
+    }
+  length = 0;
+  /* Invariants:
+     result is either == resultbuf or == NULL or malloc-allocated.
+     If length > 0, then result != NULL.  */
+
+  while (s < s_end)
+    {
+      uint32_t uc;
+      int count;
+
+      /* Fetch a Unicode character from the input string.  */
+      uc = *s;
+      s += stride;
+      /* No need to call the safe variant u32_mbtouc, because
+         u8_uctomb will verify uc anyway.  */
+
+      /* Store it in the output string.  */
+      count = _libga68_u8_uctomb (result + length, uc, allocated - length);
+      if (count == -1)
+        {
+          if (!(result == resultbuf || result == NULL))
+            free (result);
+          errno = EILSEQ;
+          return NULL;
+        }
+      if (count == -2)
+        {
+          uint8_t *memory;
+
+          allocated = (allocated > 0 ? 2 * allocated : 12);
+          if (length + 6 > allocated)
+            allocated = length + 6;
+          if (result == resultbuf || result == NULL)
+	    memory = (uint8_t *) _libga68_malloc (allocated * sizeof (uint8_t));
+          else
+	    memory =
+	      (uint8_t *) _libga68_realloc (result, allocated * sizeof (uint8_t));
+
+          if (result == resultbuf && length > 0)
+            memcpy ((char *) memory, (char *) result,
+                    length * sizeof (uint8_t));
+          result = memory;
+          count = _libga68_u8_uctomb (result + length, uc, allocated - length);
+          if (count < 0)
+            abort ();
+        }
+      length += count;
+    }
+
+  if (length == 0)
+    {
+      if (result == NULL)
+        {
+          /* Return a non-NULL value.  NULL means error.  */
+          result = (uint8_t *) _libga68_malloc (1);
+          if (result == NULL)
+            {
+              errno = ENOMEM;
+              return NULL;
+            }
+        }
+    }
+  else if (result != resultbuf && length < allocated)
+    {
+      /* Shrink the allocated memory if possible.  */
+      uint8_t *memory;
+
+      memory = (uint8_t *) _libga68_realloc_unchecked (result, length * sizeof (uint8_t));
+      if (memory != NULL)
+        result = memory;
+    }
+
+  *lengthp = length;
+  return result;
+}
+
+/* Used by ga68_u8_to_u32 below.  */
+
+static int
+_libga68_u8_mbtoucr (uint32_t *puc, const uint8_t *s, size_t n)
+{
+  uint8_t c = *s;
+
+  if (c < 0x80)
+    {
+      *puc = c;
+      return 1;
+    }
+  else if (c >= 0xc2)
+    {
+      if (c < 0xe0)
+        {
+          if (n >= 2)
+            {
+              if ((s[1] ^ 0x80) < 0x40)
+                {
+                  *puc = ((unsigned int) (c & 0x1f) << 6)
+                         | (unsigned int) (s[1] ^ 0x80);
+                  return 2;
+                }
+              /* invalid multibyte character */
+            }
+          else
+            {
+              /* incomplete multibyte character */
+              *puc = 0xfffd;
+              return -2;
+            }
+        }
+      else if (c < 0xf0)
+        {
+          if (n >= 2)
+            {
+              if ((s[1] ^ 0x80) < 0x40
+                  && (c >= 0xe1 || s[1] >= 0xa0)
+                  && (c != 0xed || s[1] < 0xa0))
+                {
+                  if (n >= 3)
+                    {
+                      if ((s[2] ^ 0x80) < 0x40)
+                        {
+                          *puc = ((unsigned int) (c & 0x0f) << 12)
+                                 | ((unsigned int) (s[1] ^ 0x80) << 6)
+                                 | (unsigned int) (s[2] ^ 0x80);
+                          return 3;
+                        }
+                      /* invalid multibyte character */
+                    }
+                  else
+                    {
+                      /* incomplete multibyte character */
+                      *puc = 0xfffd;
+                      return -2;
+                    }
+                }
+              /* invalid multibyte character */
+            }
+          else
+            {
+              /* incomplete multibyte character */
+              *puc = 0xfffd;
+              return -2;
+            }
+        }
+      else if (c <= 0xf4)
+        {
+          if (n >= 2)
+            {
+              if ((s[1] ^ 0x80) < 0x40
+                  && (c >= 0xf1 || s[1] >= 0x90)
+                  && (c < 0xf4 || (/* c == 0xf4 && */ s[1] < 0x90)))
+                {
+                  if (n >= 3)
+                    {
+                      if ((s[2] ^ 0x80) < 0x40)
+                        {
+                          if (n >= 4)
+                            {
+                              if ((s[3] ^ 0x80) < 0x40)
+                                {
+                                  *puc = ((unsigned int) (c & 0x07) << 18)
+                                         | ((unsigned int) (s[1] ^ 0x80) << 12)
+                                         | ((unsigned int) (s[2] ^ 0x80) << 6)
+                                         | (unsigned int) (s[3] ^ 0x80);
+                                  return 4;
+                                }
+                              /* invalid multibyte character */
+                            }
+                          else
+                            {
+                              /* incomplete multibyte character */
+                              *puc = 0xfffd;
+                              return -2;
+                            }
+                        }
+                      /* invalid multibyte character */
+                    }
+                  else
+                    {
+                      /* incomplete multibyte character */
+                      *puc = 0xfffd;
+                      return -2;
+                    }
+                }
+              /* invalid multibyte character */
+            }
+          else
+            {
+              /* incomplete multibyte character */
+              *puc = 0xfffd;
+              return -2;
+            }
+        }
+    }
+  /* invalid multibyte character */
+  *puc = 0xfffd;
+  return -1;
+}
+
+/* Convert UTF-8 to UTF-32/UCS-4  */
+
+uint32_t *
+_libga68_u8_to_u32 (const uint8_t *s, size_t n, uint32_t *resultbuf, size_t *lengthp)
+{
+  const uint8_t *s_end = s + n;
+  /* Output string accumulator.  */
+  uint32_t *result;
+  size_t allocated;
+  size_t length;
+
+  if (resultbuf != NULL)
+    {
+      result = resultbuf;
+      allocated = *lengthp;
+    }
+  else
+    {
+      result = NULL;
+      allocated = 0;
+    }
+  length = 0;
+  /* Invariants:
+     result is either == resultbuf or == NULL or malloc-allocated.
+     If length > 0, then result != NULL.  */
+
+  while (s < s_end)
+    {
+      uint32_t uc;
+      int count;
+
+      /* Fetch a Unicode character from the input string.  */
+      count = _libga68_u8_mbtoucr (&uc, s, s_end - s);
+      if (count < 0)
+        {
+          if (!(result == resultbuf || result == NULL))
+            free (result);
+          errno = EILSEQ;
+          return NULL;
+        }
+      s += count;
+
+      /* Store it in the output string.  */
+      if (length + 1 > allocated)
+        {
+          uint32_t *memory;
+
+          allocated = (allocated > 0 ? 2 * allocated : 12);
+          if (length + 1 > allocated)
+            allocated = length + 1;
+          if (result == resultbuf || result == NULL)
+	    memory = (uint32_t *) _libga68_malloc (allocated * sizeof (uint32_t));
+          else
+	    memory =
+	      (uint32_t *) _libga68_realloc (result, allocated * sizeof (uint32_t));
+
+          if (result == resultbuf && length > 0)
+            memcpy ((char *) memory, (char *) result,
+                    length * sizeof (uint32_t));
+          result = memory;
+        }
+      result[length++] = uc;
+    }
+
+  if (length == 0)
+    {
+      if (result == NULL)
+        {
+          /* Return a non-NULL value.  NULL means error.  */
+          result = (uint32_t *) _libga68_malloc (1);
+        }
+    }
+  else if (result != resultbuf && length < allocated)
+    {
+      /* Shrink the allocated memory if possible.  */
+      uint32_t *memory;
+
+      memory = (uint32_t *) _libga68_realloc_unchecked (result, length * sizeof (uint32_t));
+      if (memory != NULL)
+        result = memory;
+    }
+
+  *lengthp = length;
+  return result;
+}
--- /dev/null
+++ b/src/libga68/ga68.h
@@ -0,0 +1,118 @@
+/* Definitions for libga68.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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.
+
+   Under Section 7 of GPL version 3, you are granted additional permissions
+   described in the GCC Runtime Library Exception, version 3.1, as published by
+   the Free Software Foundation.
+
+   You should have received a copy of the GNU General Public License and a copy
+   of the GCC Runtime Library Exception along with this program; see the files
+   COPYING3 and COPYING.RUNTIME respectively.  If not, see
+   <http://www.gnu.org/licenses/>.  */
+
+#ifndef GA68_H
+#define GA68_H
+
+#include <stddef.h> /* For size_t.  */
+#include <stdint.h>
+#include <stdarg.h>
+#ifdef __has_include
+# if __has_include (<sys/types.h>)
+#  include <sys/types.h> /* For ssize_t.  */
+# endif
+#endif
+
+/* ga68-error.c  */
+
+void _libga68_abort (const char *fmt, ...);
+void _libga68_assert (const char *filename, unsigned int lineno);
+void _libga68_derefnil (const char *filename, unsigned int lineno);
+void _libga68_invalidcharerror (const char *filename, unsigned int lineno,
+				int c);
+
+void _libga68_bitsboundserror (const char *filename, unsigned int lineno,
+			       ssize_t pos);
+void _libga68_unreachable (const char *filename, unsigned int lineno);
+void _libga68_lower_bound (const char *filename, unsigned int lineno,
+			   ssize_t index, ssize_t lower_bound);
+void _libga68_upper_bound (const char *filename, unsigned int lineno,
+			   ssize_t index, ssize_t upper_bound);
+void _libga68_bounds (const char *filename, unsigned int lineno,
+		      ssize_t index, ssize_t lower_bound, ssize_t upper_bound);
+void _libga68_dim (const char *filename, unsigned int lineno,
+		   size_t dim, size_t index);
+void _libga68_bounds_mismatch (const char *filename, unsigned int lineno,
+			       size_t dim, ssize_t lb1, ssize_t ub1,
+			       ssize_t lb2, ssize_t ub2);
+
+/* ga68-alloc.c  */
+
+void _libga68_init_heap (void);
+void *_libga68_malloc (size_t size);
+void *_libga68_realloc (void *ptr, size_t size);
+void *_libga68_realloc_unchecked (void *ptr, size_t size);
+void _libga68_free (void *pt);
+
+/* ga68-standenv.c  */
+
+float _libga68_random (void);
+double _libga68_longrandom (void);
+long double _libga68_longlongrandom (void);
+
+/* ga68-posix.c  */
+
+int _libga68_posixerrno (void);
+void _libga68_posixperror (uint32_t *s, size_t len, size_t stride);
+uint32_t *_libga68_posixstrerror (int errnum, size_t *len);
+long long int _libga68_posixfsize (int fd);
+int _libga68_posixfopen (uint32_t *pathname, size_t len, size_t stride, unsigned int flags);
+int _libga68_posixcreat (uint32_t *pathname, size_t len, size_t stride, uint32_t mode);
+int _libga68_posixclose (int fd);
+int _libga68_posixargc (void);
+uint32_t *_libga68_posixargv (int n, size_t *len);
+void _libga68_posixgetenv (uint32_t *s, size_t len, size_t stride,
+			   uint32_t **r, size_t *rlen);
+void _libga68_posixputs (uint32_t *s, size_t len, size_t stride);
+uint32_t _libga68_posixputchar (uint32_t c);
+uint32_t _libga68_posixfputc (int fd, uint32_t c);
+int _libga68_posixfputs (int fd, uint32_t *s, size_t len, size_t stride);
+
+uint32_t _libga68_posixgetchar (void);
+uint32_t _libga68_posixfgetc (int fd);
+uint32_t *_libga68_posixfgets (int fd, int nchars, size_t *len);
+uint32_t *_libga68_posixgets (int nchars, size_t *len);
+
+int _libga68_posixfconnect (uint32_t *str, size_t len, size_t stride,
+			    int port);
+
+/* ga68-unistr.c  */
+
+int _libga68_u32_cmp (const uint32_t *s1, size_t stride1,
+		      const uint32_t *s2, size_t stride2,
+		      size_t n);
+int _libga68_u32_cmp2 (const uint32_t *s1, size_t n1, size_t stride1,
+		       const uint32_t *s2, size_t n2, size_t stride2);
+int _libga68_u8_uctomb (uint8_t *s, uint32_t uc, ptrdiff_t n);
+int _libga68_u8_mbtouc (uint32_t *puc, const uint8_t *s, size_t n);
+uint8_t *_libga68_u32_to_u8 (const uint32_t *s, size_t n, size_t stride,
+			     uint8_t *resultbuf, size_t *lengthp);
+uint32_t *_libga68_u8_to_u32 (const uint8_t *s, size_t n,
+			      uint32_t *resultbuf, size_t *lengthp);
+
+/* libga68.c  */
+
+extern int _libga68_argc;
+extern char **_libga68_argv;
+
+void _libga68_set_exit_status (int status);
+
+#endif /* ! GA68_H */
--- /dev/null
+++ b/src/libga68/libga68.c
@@ -0,0 +1,52 @@
+/* GNU Algol Compiler run-time.
+   Copyright (C) 2025 Jose E. Marchesi.
+
+   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.
+
+   Under Section 7 of GPL version 3, you are granted additional permissions
+   described in the GCC Runtime Library Exception, version 3.1, as published by
+   the Free Software Foundation.
+
+   You should have received a copy of the GNU General Public License and a copy
+   of the 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 "ga68.h"
+
+/* argc and argv are preserved in the following objects.  */
+
+int _libga68_argc;
+char **_libga68_argv;
+
+/* Exit status of the program reported to the OS upon exit.  */
+
+static int exit_status;
+
+void
+_libga68_set_exit_status (int status)
+{
+  exit_status = status;
+}
+
+/* Entry point for Algol 68 programs.  */
+
+void __algol68_main (void);
+
+int
+main (int argc, char **argv)
+{
+  _libga68_argc = argc;
+  _libga68_argv = argv;
+
+  _libga68_init_heap ();
+  __algol68_main ();
+  return exit_status;
+}
--- /dev/null
+++ b/src/libga68/libga68.spec.in
@@ -0,0 +1,11 @@
+#
+# This spec file is read by ga68 when linking.
+# It is used to specify the libraries we need to link in, in the right
+# order.
+#
+
+%rename link linkorig_ga68_renamed
+*link: %(linkorig_ga68_renamed)
+
+%rename lib liborig_ga68_renamed
+*lib: %{noga68lib: ; :@SPEC_LIBGA68_DEPS@} %(liborig_ga68_renamed)
