public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-6480] Fix modula-2 rename autogenerated .c files to .cc
@ 2023-03-04 13:11 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2023-03-04 13:11 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:fbd2eda12c7fc66d5f24b208985430fcbe6f5ab5
commit r13-6480-gfbd2eda12c7fc66d5f24b208985430fcbe6f5ab5
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Sat Mar 4 13:11:05 2023 +0000
Fix modula-2 rename autogenerated .c files to .cc
This patch adds the replacement .cc files for the
autogenerated tools.
gcc/m2/ChangeLog:
* mc-boot-ch/GBuiltins.cc: New file.
* mc-boot-ch/Gdtoa.cc: New file.
* mc-boot-ch/Gerrno.cc: New file.
* mc-boot-ch/Gldtoa.cc: New file.
* mc-boot-ch/Gm2rtsdummy.cc: New file.
* mc-boot/GASCII.cc: New file.
* mc-boot/GArgs.cc: New file.
* mc-boot/GAssertion.cc: New file.
* mc-boot/GBreak.cc: New file.
* mc-boot/GCmdArgs.cc: New file.
* mc-boot/GDebug.cc: New file.
* mc-boot/GDynamicStrings.cc: New file.
* mc-boot/GEnvironment.cc: New file.
* mc-boot/GFIO.cc: New file.
* mc-boot/GFormatStrings.cc: New file.
* mc-boot/GFpuIO.cc: New file.
* mc-boot/GIO.cc: New file.
* mc-boot/GIndexing.cc: New file.
* mc-boot/GM2Dependent.cc: New file.
* mc-boot/GM2EXCEPTION.cc: New file.
* mc-boot/GM2RTS.cc: New file.
* mc-boot/GMemUtils.cc: New file.
* mc-boot/GNumberIO.cc: New file.
* mc-boot/GPushBackInput.cc: New file.
* mc-boot/GRTExceptions.cc: New file.
* mc-boot/GRTint.cc: New file.
* mc-boot/GSArgs.cc: New file.
* mc-boot/GSFIO.cc: New file.
* mc-boot/GStdIO.cc: New file.
* mc-boot/GStorage.cc: New file.
* mc-boot/GStrCase.cc: New file.
* mc-boot/GStrIO.cc: New file.
* mc-boot/GStrLib.cc: New file.
* mc-boot/GStringConvert.cc: New file.
* mc-boot/GSysStorage.cc: New file.
* mc-boot/GTimeString.cc: New file.
* mc-boot/Galists.cc: New file.
* mc-boot/Gdecl.cc: New file.
* mc-boot/Gkeyc.cc: New file.
* mc-boot/Glists.cc: New file.
* mc-boot/GmcComment.cc: New file.
* mc-boot/GmcComp.cc: New file.
* mc-boot/GmcDebug.cc: New file.
* mc-boot/GmcError.cc: New file.
* mc-boot/GmcFileName.cc: New file.
* mc-boot/GmcLexBuf.cc: New file.
* mc-boot/GmcMetaError.cc: New file.
* mc-boot/GmcOptions.cc: New file.
* mc-boot/GmcPreprocess.cc: New file.
* mc-boot/GmcPretty.cc: New file.
* mc-boot/GmcPrintf.cc: New file.
* mc-boot/GmcQuiet.cc: New file.
* mc-boot/GmcReserved.cc: New file.
* mc-boot/GmcSearch.cc: New file.
* mc-boot/GmcStack.cc: New file.
* mc-boot/GmcStream.cc: New file.
* mc-boot/Gmcp1.cc: New file.
* mc-boot/Gmcp2.cc: New file.
* mc-boot/Gmcp3.cc: New file.
* mc-boot/Gmcp4.cc: New file.
* mc-boot/Gmcp5.cc: New file.
* mc-boot/GnameKey.cc: New file.
* mc-boot/GsymbolKey.cc: New file.
* mc-boot/Gtop.cc: New file.
* mc-boot/Gvarargs.cc: New file.
* mc-boot/Gwlists.cc: New file.
* pge-boot/GASCII.cc: New file.
* pge-boot/GArgs.cc: New file.
* pge-boot/GAssertion.cc: New file.
* pge-boot/GBuiltins.cc: New file.
* pge-boot/GDebug.cc: New file.
* pge-boot/GDynamicStrings.cc: New file.
* pge-boot/GFIO.cc: New file.
* pge-boot/GIO.cc: New file.
* pge-boot/GIndexing.cc: New file.
* pge-boot/GLists.cc: New file.
* pge-boot/GM2Dependent.cc: New file.
* pge-boot/GM2EXCEPTION.cc: New file.
* pge-boot/GM2LINK.cc: New file.
* pge-boot/GM2RTS.cc: New file.
* pge-boot/GNameKey.cc: New file.
* pge-boot/GNumberIO.cc: New file.
* pge-boot/GOutput.cc: New file.
* pge-boot/GPushBackInput.cc: New file.
* pge-boot/GRTExceptions.cc: New file.
* pge-boot/GRTco.cc: New file.
* pge-boot/GSFIO.cc: New file.
* pge-boot/GSYSTEM.cc: New file.
* pge-boot/GSelective.cc: New file.
* pge-boot/GStdIO.cc: New file.
* pge-boot/GStorage.cc: New file.
* pge-boot/GStrCase.cc: New file.
* pge-boot/GStrIO.cc: New file.
* pge-boot/GStrLib.cc: New file.
* pge-boot/GSymbolKey.cc: New file.
* pge-boot/GSysExceptions.cc: New file.
* pge-boot/GSysStorage.cc: New file.
* pge-boot/Gabort.cc: New file.
* pge-boot/Gbnflex.cc: New file.
* pge-boot/Gcbuiltin.cc: New file.
* pge-boot/Gdtoa.cc: New file.
* pge-boot/Gerrno.cc: New file.
* pge-boot/Gldtoa.cc: New file.
* pge-boot/Glibc.cc: New file.
* pge-boot/Glibm.cc: New file.
* pge-boot/Gmcrts.cc: New file.
* pge-boot/Gpge.cc: New file.
* pge-boot/Gwrapc.cc: New file.
* pge-boot/main.cc: New file.
* pge-boot/network.cc: New file.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/mc-boot-ch/GBuiltins.cc | 43 +
gcc/m2/mc-boot-ch/Gdtoa.cc | 184 +
gcc/m2/mc-boot-ch/Gerrno.cc | 54 +
gcc/m2/mc-boot-ch/Gldtoa.cc | 107 +
gcc/m2/mc-boot-ch/Gm2rtsdummy.cc | 62 +
gcc/m2/mc-boot/GASCII.cc | 86 +
gcc/m2/mc-boot/GArgs.cc | 120 +
gcc/m2/mc-boot/GAssertion.cc | 71 +
gcc/m2/mc-boot/GBreak.cc | 47 +
gcc/m2/mc-boot/GCmdArgs.cc | 322 +
gcc/m2/mc-boot/GDebug.cc | 168 +
gcc/m2/mc-boot/GDynamicStrings.cc | 2676 ++++
gcc/m2/mc-boot/GEnvironment.cc | 129 +
gcc/m2/mc-boot/GFIO.cc | 2322 +++
gcc/m2/mc-boot/GFormatStrings.cc | 845 ++
gcc/m2/mc-boot/GFpuIO.cc | 336 +
gcc/m2/mc-boot/GIO.cc | 479 +
gcc/m2/mc-boot/GIndexing.cc | 491 +
gcc/m2/mc-boot/GM2Dependent.cc | 1407 ++
gcc/m2/mc-boot/GM2EXCEPTION.cc | 89 +
gcc/m2/mc-boot/GM2RTS.cc | 819 ++
gcc/m2/mc-boot/GMemUtils.cc | 126 +
gcc/m2/mc-boot/GNumberIO.cc | 776 +
gcc/m2/mc-boot/GPushBackInput.cc | 488 +
gcc/m2/mc-boot/GRTExceptions.cc | 1223 ++
gcc/m2/mc-boot/GRTint.cc | 1106 ++
gcc/m2/mc-boot/GSArgs.cc | 125 +
gcc/m2/mc-boot/GSFIO.cc | 216 +
gcc/m2/mc-boot/GStdIO.cc | 269 +
gcc/m2/mc-boot/GStorage.cc | 74 +
gcc/m2/mc-boot/GStrCase.cc | 175 +
gcc/m2/mc-boot/GStrIO.cc | 277 +
gcc/m2/mc-boot/GStrLib.cc | 346 +
gcc/m2/mc-boot/GStringConvert.cc | 2005 +++
gcc/m2/mc-boot/GSysStorage.cc | 249 +
gcc/m2/mc-boot/GTimeString.cc | 91 +
gcc/m2/mc-boot/Galists.cc | 440 +
gcc/m2/mc-boot/Gdecl.cc | 26926 +++++++++++++++++++++++++++++++++++
gcc/m2/mc-boot/Gkeyc.cc | 1619 +++
gcc/m2/mc-boot/Glists.cc | 439 +
| 468 +
gcc/m2/mc-boot/GmcComp.cc | 660 +
gcc/m2/mc-boot/GmcDebug.cc | 86 +
gcc/m2/mc-boot/GmcError.cc | 1197 ++
gcc/m2/mc-boot/GmcFileName.cc | 152 +
gcc/m2/mc-boot/GmcLexBuf.cc | 1849 +++
gcc/m2/mc-boot/GmcMetaError.cc | 1880 +++
gcc/m2/mc-boot/GmcOptions.cc | 1122 ++
gcc/m2/mc-boot/GmcPreprocess.cc | 181 +
gcc/m2/mc-boot/GmcPretty.cc | 468 +
gcc/m2/mc-boot/GmcPrintf.cc | 655 +
gcc/m2/mc-boot/GmcQuiet.cc | 129 +
gcc/m2/mc-boot/GmcReserved.cc | 40 +
gcc/m2/mc-boot/GmcSearch.cc | 408 +
gcc/m2/mc-boot/GmcStack.cc | 228 +
gcc/m2/mc-boot/GmcStream.cc | 266 +
gcc/m2/mc-boot/Gmcp1.cc | 7265 ++++++++++
gcc/m2/mc-boot/Gmcp2.cc | 7637 ++++++++++
gcc/m2/mc-boot/Gmcp3.cc | 7854 ++++++++++
gcc/m2/mc-boot/Gmcp4.cc | 7717 ++++++++++
gcc/m2/mc-boot/Gmcp5.cc | 8576 +++++++++++
gcc/m2/mc-boot/GnameKey.cc | 584 +
gcc/m2/mc-boot/GsymbolKey.cc | 406 +
gcc/m2/mc-boot/Gtop.cc | 100 +
gcc/m2/mc-boot/Gvarargs.cc | 431 +
gcc/m2/mc-boot/Gwlists.cc | 471 +
gcc/m2/pge-boot/GASCII.cc | 84 +
gcc/m2/pge-boot/GArgs.cc | 118 +
gcc/m2/pge-boot/GAssertion.cc | 69 +
gcc/m2/pge-boot/GBuiltins.cc | 43 +
gcc/m2/pge-boot/GDebug.cc | 168 +
gcc/m2/pge-boot/GDynamicStrings.cc | 2679 ++++
gcc/m2/pge-boot/GFIO.cc | 2325 +++
gcc/m2/pge-boot/GIO.cc | 479 +
gcc/m2/pge-boot/GIndexing.cc | 493 +
gcc/m2/pge-boot/GLists.cc | 427 +
gcc/m2/pge-boot/GM2Dependent.cc | 1410 ++
gcc/m2/pge-boot/GM2EXCEPTION.cc | 88 +
gcc/m2/pge-boot/GM2LINK.cc | 27 +
gcc/m2/pge-boot/GM2RTS.cc | 822 ++
gcc/m2/pge-boot/GNameKey.cc | 612 +
gcc/m2/pge-boot/GNumberIO.cc | 777 +
gcc/m2/pge-boot/GOutput.cc | 315 +
gcc/m2/pge-boot/GPushBackInput.cc | 489 +
gcc/m2/pge-boot/GRTExceptions.cc | 1226 ++
gcc/m2/pge-boot/GRTco.cc | 127 +
gcc/m2/pge-boot/GSFIO.cc | 215 +
gcc/m2/pge-boot/GSYSTEM.cc | 38 +
gcc/m2/pge-boot/GSelective.cc | 275 +
gcc/m2/pge-boot/GStdIO.cc | 267 +
gcc/m2/pge-boot/GStorage.cc | 72 +
gcc/m2/pge-boot/GStrCase.cc | 175 +
gcc/m2/pge-boot/GStrIO.cc | 277 +
gcc/m2/pge-boot/GStrLib.cc | 346 +
gcc/m2/pge-boot/GSymbolKey.cc | 556 +
gcc/m2/pge-boot/GSysExceptions.cc | 237 +
gcc/m2/pge-boot/GSysStorage.cc | 249 +
gcc/m2/pge-boot/Gabort.cc | 30 +
gcc/m2/pge-boot/Gbnflex.cc | 602 +
gcc/m2/pge-boot/Gcbuiltin.cc | 173 +
gcc/m2/pge-boot/Gdtoa.cc | 184 +
gcc/m2/pge-boot/Gerrno.cc | 54 +
gcc/m2/pge-boot/Gldtoa.cc | 107 +
gcc/m2/pge-boot/Glibc.cc | 279 +
gcc/m2/pge-boot/Glibm.cc | 224 +
gcc/m2/pge-boot/Gmcrts.cc | 54 +
gcc/m2/pge-boot/Gpge.cc | 9753 +++++++++++++
gcc/m2/pge-boot/Gwrapc.cc | 183 +
gcc/m2/pge-boot/main.cc | 123 +
gcc/m2/pge-boot/network.cc | 40 +
110 files changed, 125948 insertions(+)
diff --git a/gcc/m2/mc-boot-ch/GBuiltins.cc b/gcc/m2/mc-boot-ch/GBuiltins.cc
new file mode 100644
index 00000000000..a762635d544
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/GBuiltins.cc
@@ -0,0 +1,43 @@
+/* GBuiltins.cc dummy module to aid linking mc projects.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#if defined(__cplusplus)
+#define EXTERN extern "C"
+#else
+#define EXTERN
+#endif
+
+
+/* init module constructor. */
+
+EXTERN
+void
+_M2_Builtins_init (void)
+{
+}
+
+/* finish module deconstructor. */
+
+EXTERN
+void
+_M2_Builtins_fini (void)
+{
+}
diff --git a/gcc/m2/mc-boot-ch/Gdtoa.cc b/gcc/m2/mc-boot-ch/Gdtoa.cc
new file mode 100644
index 00000000000..e64fe5ad307
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gdtoa.cc
@@ -0,0 +1,184 @@
+/* Gdtoa.cc provides access to double string conversion.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#define GM2
+
+#include "config.h"
+#include "system.h"
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define MAX_FP_DIGITS 500
+
+typedef enum Mode { maxsignicant, decimaldigits } Mode;
+
+/* maxsignicant: return a string containing max(1,ndigits)
+ significant digits. The return string contains the string
+ produced by ecvt. decimaldigits: return a string produced by
+ fcvt. The string will contain ndigits past the decimal point
+ (ndigits may be negative). */
+
+double
+dtoa_strtod (const char *s, int *error)
+{
+ char *endp;
+ double d;
+
+ errno = 0;
+ d = strtod (s, &endp);
+ if (endp != NULL && (*endp == '\0'))
+ *error = (errno != 0);
+ else
+ *error = TRUE;
+ return d;
+}
+
+/* dtoa_calcmaxsig - calculates the position of the decimal point it
+ also removes the decimal point and exponent from string, p. */
+
+int
+dtoa_calcmaxsig (char *p, int ndigits)
+{
+ char *e;
+ char *o;
+ int x;
+
+ e = index (p, 'E');
+ if (e == NULL)
+ x = 0;
+ else
+ {
+ *e = (char)0;
+ x = atoi (e + 1);
+ }
+
+ o = index (p, '.');
+ if (o == NULL)
+ return strlen (p) + x;
+ else
+ {
+ memmove (o, o + 1, ndigits - (o - p));
+ return o - p + x;
+ }
+}
+
+/* dtoa_calcdecimal - calculates the position of the decimal point it
+ also removes the decimal point and exponent from string, p. It
+ truncates the digits in p accordingly to ndigits. Ie ndigits is
+ the number of digits after the '.' */
+
+int
+dtoa_calcdecimal (char *p, int str_size, int ndigits)
+{
+ char *e;
+ char *o;
+ int x;
+ int l;
+
+ e = index (p, 'E');
+ if (e == NULL)
+ x = 0;
+ else
+ {
+ *e = (char)0;
+ x = atoi (e + 1);
+ }
+
+ l = strlen (p);
+ o = index (p, '.');
+ if (o == NULL)
+ x += strlen (p);
+ else
+ {
+ int m = strlen (o);
+ memmove (o, o + 1, l - (o - p));
+ if (m > 0)
+ o[m - 1] = '0';
+ x += o - p;
+ }
+ if ((x + ndigits >= 0) && (x + ndigits < str_size))
+ p[x + ndigits] = (char)0;
+ return x;
+}
+
+
+int
+dtoa_calcsign (char *p, int str_size)
+{
+ if (p[0] == '-')
+ {
+ memmove (p, p + 1, str_size - 1);
+ return TRUE;
+ }
+ else
+ return FALSE;
+}
+
+
+char *
+dtoa_dtoa (double d, int mode, int ndigits, int *decpt, int *sign)
+{
+ char format[50];
+ char *p;
+ int r;
+ switch (mode)
+ {
+
+ case maxsignicant:
+ ndigits += 20; /* enough for exponent. */
+ p = (char *) malloc (ndigits);
+ snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "E");
+ snprintf (p, ndigits, format, d);
+ *sign = dtoa_calcsign (p, ndigits);
+ *decpt = dtoa_calcmaxsig (p, ndigits);
+ return p;
+ case decimaldigits:
+ p = (char *) malloc (MAX_FP_DIGITS + 20);
+ snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "E");
+ snprintf (p, MAX_FP_DIGITS + 20, format, d);
+ *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20);
+ *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits);
+ return p;
+ default:
+ abort ();
+ }
+}
+
+#if defined(GM2)
+/* GNU Modula-2 hooks */
+
+void
+_M2_dtoa_init (void)
+{
+}
+
+void
+_M2_dtoa_fini (void)
+{
+}
+#endif
+
+#ifdef __cplusplus
+}
+#endif
diff --git a/gcc/m2/mc-boot-ch/Gerrno.cc b/gcc/m2/mc-boot-ch/Gerrno.cc
new file mode 100644
index 00000000000..f8832329ec1
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gerrno.cc
@@ -0,0 +1,54 @@
+/* Gerrno.cc provides access to errno for Modula-2.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+#include "ansidecl.h"
+
+# ifdef __cplusplus
+extern "C" {
+# endif
+
+/* geterrno returns errno. */
+
+int
+errno_geterrno (void)
+{
+ return errno;
+}
+
+/* init constructor for the module. */
+
+void
+_M2_errno_init (int argc, char *p)
+{
+}
+
+/* finish deconstructor for the module. */
+
+void
+_M2_errno_fini (int argc, char *p)
+{
+}
+
+# ifdef __cplusplus
+}
+# endif
diff --git a/gcc/m2/mc-boot-ch/Gldtoa.cc b/gcc/m2/mc-boot-ch/Gldtoa.cc
new file mode 100644
index 00000000000..73f3d1806e5
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gldtoa.cc
@@ -0,0 +1,107 @@
+/* Gldtoa.cc provides access to long double string conversion.
+
+Copyright (C) 2016-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+
+#include "gm2-libs-host.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define MAX_FP_DIGITS 500
+
+typedef enum Mode { maxsignicant, decimaldigits } Mode;
+
+extern int dtoa_calcmaxsig (char *p, int ndigits);
+extern int dtoa_calcdecimal (char *p, int str_size, int ndigits);
+extern int dtoa_calcsign (char *p, int str_size);
+
+/* maxsignicant: return a string containing max(1,ndigits)
+ significant digits. The return string contains the string
+ produced by snprintf. decimaldigits: return a string produced by
+ fcvt. The string will contain ndigits past the decimal point
+ (ndigits may be negative). */
+
+long double
+ldtoa_strtold (const char *s, int *error)
+{
+ char *endp;
+ long double d;
+
+ errno = 0;
+#if defined(HAVE_STRTOLD)
+ d = strtold (s, &endp);
+#else
+ /* fall back to using strtod. */
+ d = (long double)strtod (s, &endp);
+#endif
+ if (endp != NULL && (*endp == '\0'))
+ *error = (errno != 0);
+ else
+ *error = TRUE;
+ return d;
+}
+
+char *
+ldtoa_ldtoa (long double d, int mode, int ndigits, int *decpt, int *sign)
+{
+ char format[50];
+ char *p;
+ int r;
+ switch (mode)
+ {
+
+ case maxsignicant:
+ ndigits += 20; /* enough for exponent. */
+ p = (char *)malloc (ndigits);
+ snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "LE");
+ snprintf (p, ndigits, format, d);
+ *sign = dtoa_calcsign (p, ndigits);
+ *decpt = dtoa_calcmaxsig (p, ndigits);
+ return p;
+ case decimaldigits:
+ p = (char *)malloc (MAX_FP_DIGITS + 20);
+ snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "LE");
+ snprintf (p, MAX_FP_DIGITS + 20, format, d);
+ *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20);
+ *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits);
+ return p;
+ default:
+ abort ();
+ }
+}
+
+/* GNU Modula-2 hooks */
+
+void
+_M2_ldtoa_init (void)
+{
+}
+
+void
+_M2_ldtoa_fini (void)
+{
+}
+# ifdef __cplusplus
+}
+# endif
diff --git a/gcc/m2/mc-boot-ch/Gm2rtsdummy.cc b/gcc/m2/mc-boot-ch/Gm2rtsdummy.cc
new file mode 100644
index 00000000000..c0ae9795948
--- /dev/null
+++ b/gcc/m2/mc-boot-ch/Gm2rtsdummy.cc
@@ -0,0 +1,62 @@
+/* m2rts.cc provides a C interface to M2RTS.mod.
+
+Copyright (C) 2019-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+/* This is a minimal wrapper for M2RTS.c which allows mc to be built with
+ a nul pathname "m2pim" library and then to link against an installed
+ m2pim library. */
+
+typedef void (*proc_con) (int, char **, char **);
+typedef void (*proc_dep) (void);
+
+#if 0
+/* Used if -fscaffold-dynamic were selected. */
+extern "C" void M2RTS_RequestDependant (const char *modulename, const char *libname,
+ const char *dependancy, const char *deplib);
+#endif
+
+extern "C" void m2pim_M2RTS_RegisterModule (const char *modulename, const char *libname,
+ proc_con init, proc_con fini, proc_dep dependencies);
+
+/* Fixup references, the code will not be used though, as it is only used if
+ -fscaffold-dynamic is selected (and mc uses -fscaffold-static). */
+
+extern "C"
+void M2RTS_RegisterModule (const char *modulename, const char *libname,
+ proc_con init, proc_con fini, proc_dep dependencies)
+{
+ m2pim_M2RTS_RegisterModule (modulename, libname, init, fini, dependencies);
+}
+
+#if 0
+extern "C" void _M2_M2RTS_init (void);
+
+extern "C" void M2RTS_ConstructModules (const char *,
+ int argc, char *argv[], char *envp[]);
+extern "C" void M2RTS_Terminate (void);
+extern "C" void M2RTS_DeconstructModules (void);
+
+extern "C" void M2RTS_Halt (const char *, int, const char *, const char *) __attribute__ ((noreturn));
+#endif
diff --git a/gcc/m2/mc-boot/GASCII.cc b/gcc/m2/mc-boot/GASCII.cc
new file mode 100644
index 00000000000..2f768ce24c8
--- /dev/null
+++ b/gcc/m2/mc-boot/GASCII.cc
@@ -0,0 +1,86 @@
+/* do not edit automatically generated by mc from ASCII. */
+/* ASCII.mod dummy companion module for the definition.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _ASCII_H
+#define _ASCII_C
+
+
+# define ASCII_nul (char) 000
+# define ASCII_soh (char) 001
+# define ASCII_stx (char) 002
+# define ASCII_etx (char) 003
+# define ASCII_eot (char) 004
+# define ASCII_enq (char) 005
+# define ASCII_ack (char) 006
+# define ASCII_bel (char) 007
+# define ASCII_bs (char) 010
+# define ASCII_ht (char) 011
+# define ASCII_nl (char) 012
+# define ASCII_vt (char) 013
+# define ASCII_np (char) 014
+# define ASCII_cr (char) 015
+# define ASCII_so (char) 016
+# define ASCII_si (char) 017
+# define ASCII_dle (char) 020
+# define ASCII_dc1 (char) 021
+# define ASCII_dc2 (char) 022
+# define ASCII_dc3 (char) 023
+# define ASCII_dc4 (char) 024
+# define ASCII_nak (char) 025
+# define ASCII_syn (char) 026
+# define ASCII_etb (char) 027
+# define ASCII_can (char) 030
+# define ASCII_em (char) 031
+# define ASCII_sub (char) 032
+# define ASCII_esc (char) 033
+# define ASCII_fs (char) 034
+# define ASCII_gs (char) 035
+# define ASCII_rs (char) 036
+# define ASCII_us (char) 037
+# define ASCII_sp (char) 040
+# define ASCII_lf ASCII_nl
+# define ASCII_ff ASCII_np
+# define ASCII_eof ASCII_eot
+# define ASCII_tab ASCII_ht
+# define ASCII_del (char) 0177
+# define ASCII_EOL ASCII_nl
+
+extern "C" void _M2_ASCII_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_ASCII_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GArgs.cc b/gcc/m2/mc-boot/GArgs.cc
new file mode 100644
index 00000000000..106ddfd30c6
--- /dev/null
+++ b/gcc/m2/mc-boot/GArgs.cc
@@ -0,0 +1,120 @@
+/* do not edit automatically generated by mc from Args. */
+/* Args.mod provide access to command line arguments.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _Args_H
+#define _Args_C
+
+# include "GUnixArgs.h"
+# include "GASCII.h"
+
+# define MaxArgs 255
+# define MaxString 4096
+typedef struct Args__T2_a Args__T2;
+
+typedef Args__T2 *Args__T1;
+
+typedef struct Args__T3_a Args__T3;
+
+struct Args__T2_a { Args__T3 * array[MaxArgs+1]; };
+struct Args__T3_a { char array[MaxString+1]; };
+static Args__T1 Source;
+
+/*
+ GetArg - returns the nth argument from the command line.
+ The success of the operation is returned.
+*/
+
+extern "C" unsigned int Args_GetArg (char *a, unsigned int _a_high, unsigned int n);
+
+/*
+ Narg - returns the number of arguments available from
+ command line.
+*/
+
+extern "C" unsigned int Args_Narg (void);
+
+
+/*
+ GetArg - returns the nth argument from the command line.
+ The success of the operation is returned.
+*/
+
+extern "C" unsigned int Args_GetArg (char *a, unsigned int _a_high, unsigned int n)
+{
+ int i;
+ unsigned int High;
+ unsigned int j;
+
+ i = (int ) (n);
+ j = 0;
+ High = _a_high;
+ if (i < (UnixArgs_GetArgC ()))
+ {
+ Source = static_cast<Args__T1> (UnixArgs_GetArgV ());
+ while ((j < High) && ((*(*Source).array[i]).array[j] != ASCII_nul))
+ {
+ a[j] = (*(*Source).array[i]).array[j];
+ j += 1;
+ }
+ }
+ if (j <= High)
+ {
+ a[j] = ASCII_nul;
+ }
+ return i < (UnixArgs_GetArgC ());
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Narg - returns the number of arguments available from
+ command line.
+*/
+
+extern "C" unsigned int Args_Narg (void)
+{
+ return UnixArgs_GetArgC ();
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_Args_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Args_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GAssertion.cc b/gcc/m2/mc-boot/GAssertion.cc
new file mode 100644
index 00000000000..21ee6c0b2f2
--- /dev/null
+++ b/gcc/m2/mc-boot/GAssertion.cc
@@ -0,0 +1,71 @@
+/* do not edit automatically generated by mc from Assertion. */
+/* Assertion.mod provides an assert procedure.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _Assertion_H
+#define _Assertion_C
+
+# include "GStrIO.h"
+# include "GM2RTS.h"
+
+
+/*
+ Assert - tests the boolean Condition, if it fails then HALT is called.
+*/
+
+extern "C" void Assertion_Assert (unsigned int Condition);
+
+
+/*
+ Assert - tests the boolean Condition, if it fails then HALT is called.
+*/
+
+extern "C" void Assertion_Assert (unsigned int Condition)
+{
+ if (! Condition)
+ {
+ StrIO_WriteString ((const char *) "assert failed - halting system", 30);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+extern "C" void _M2_Assertion_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Assertion_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GBreak.cc b/gcc/m2/mc-boot/GBreak.cc
new file mode 100644
index 00000000000..9be003bd619
--- /dev/null
+++ b/gcc/m2/mc-boot/GBreak.cc
@@ -0,0 +1,47 @@
+/* do not edit automatically generated by mc from Break. */
+/* Break.mod provides a dummy compatibility library for legacy systems.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _Break_H
+#define _Break_C
+
+
+
+extern "C" void _M2_Break_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Break_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GCmdArgs.cc b/gcc/m2/mc-boot/GCmdArgs.cc
new file mode 100644
index 00000000000..c304a407182
--- /dev/null
+++ b/gcc/m2/mc-boot/GCmdArgs.cc
@@ -0,0 +1,322 @@
+/* do not edit automatically generated by mc from CmdArgs. */
+/* CmdArgs.mod provides procedures to retrieve arguments from strings.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _CmdArgs_H
+#define _CmdArgs_C
+
+# include "GASCII.h"
+# include "GStrLib.h"
+
+# define esc '\\'
+# define space ' '
+# define squote '\''
+# define dquote '"'
+# define tab ' '
+
+/*
+ GetArg - takes a command line and attempts to extract argument, n,
+ from CmdLine. The resulting argument is placed into, a.
+ The result of the operation is returned.
+*/
+
+extern "C" unsigned int CmdArgs_GetArg (const char *CmdLine_, unsigned int _CmdLine_high, unsigned int n, char *Argi, unsigned int _Argi_high);
+
+/*
+ Narg - returns the number of arguments available from
+ command line, CmdLine.
+*/
+
+extern "C" unsigned int CmdArgs_Narg (const char *CmdLine_, unsigned int _CmdLine_high);
+
+/*
+ GetNextArg - Returns true if another argument may be found.
+ The argument is taken from CmdLine at position Index,
+ Arg is filled with the found argument.
+*/
+
+static unsigned int GetNextArg (const char *CmdLine_, unsigned int _CmdLine_high, unsigned int *CmdIndex, char *Arg, unsigned int _Arg_high);
+
+/*
+ CopyUntilSpace - copies characters until a Space character is found.
+*/
+
+static void CopyUntilSpace (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh);
+
+/*
+ CopyUntil - copies characters until the UntilChar is found.
+*/
+
+static void CopyUntil (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh, char UntilChar);
+
+/*
+ CopyChar - copies a character from string From to string To and
+ takes into consideration escape characters. ie \x
+ Where x is any character.
+*/
+
+static void CopyChar (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh);
+static unsigned int Escape (char ch);
+static unsigned int Space (char ch);
+static unsigned int DoubleQuote (char ch);
+static unsigned int SingleQuote (char ch);
+
+
+/*
+ GetNextArg - Returns true if another argument may be found.
+ The argument is taken from CmdLine at position Index,
+ Arg is filled with the found argument.
+*/
+
+static unsigned int GetNextArg (const char *CmdLine_, unsigned int _CmdLine_high, unsigned int *CmdIndex, char *Arg, unsigned int _Arg_high)
+{
+ unsigned int ArgIndex;
+ unsigned int HighA;
+ unsigned int HighC;
+ char CmdLine[_CmdLine_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (CmdLine, CmdLine_, _CmdLine_high+1);
+
+ HighA = _Arg_high; /* Index into Arg */
+ HighC = StrLib_StrLen ((const char *) CmdLine, _CmdLine_high);
+ ArgIndex = 0;
+ /* Skip spaces */
+ while (((*CmdIndex) < HighC) && (Space (CmdLine[(*CmdIndex)])))
+ {
+ (*CmdIndex) += 1;
+ }
+ if ((*CmdIndex) < HighC)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (SingleQuote (CmdLine[(*CmdIndex)]))
+ {
+ /* Skip over the single quote */
+ (*CmdIndex) += 1;
+ CopyUntil ((const char *) CmdLine, _CmdLine_high, CmdIndex, HighC, (char *) Arg, _Arg_high, &ArgIndex, HighA, squote);
+ (*CmdIndex) += 1;
+ }
+ else if (DoubleQuote (CmdLine[(*CmdIndex)]))
+ {
+ /* avoid dangling else. */
+ /* Skip over the double quote */
+ (*CmdIndex) += 1;
+ CopyUntil ((const char *) CmdLine, _CmdLine_high, CmdIndex, HighC, (char *) Arg, _Arg_high, &ArgIndex, HighA, dquote);
+ (*CmdIndex) += 1;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ CopyUntilSpace ((const char *) CmdLine, _CmdLine_high, CmdIndex, HighC, (char *) Arg, _Arg_high, &ArgIndex, HighA);
+ }
+ }
+ /* Skip spaces */
+ while (((*CmdIndex) < HighC) && (Space (CmdLine[(*CmdIndex)])))
+ {
+ (*CmdIndex) += 1;
+ }
+ if (ArgIndex < HighA)
+ {
+ Arg[ArgIndex] = ASCII_nul;
+ }
+ return (*CmdIndex) < HighC;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ CopyUntilSpace - copies characters until a Space character is found.
+*/
+
+static void CopyUntilSpace (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh)
+{
+ char From[_From_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (From, From_, _From_high+1);
+
+ while ((((*FromIndex) < FromHigh) && ((*ToIndex) < ToHigh)) && (! (Space (From[(*FromIndex)]))))
+ {
+ CopyChar ((const char *) From, _From_high, FromIndex, FromHigh, (char *) To, _To_high, ToIndex, ToHigh);
+ }
+}
+
+
+/*
+ CopyUntil - copies characters until the UntilChar is found.
+*/
+
+static void CopyUntil (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh, char UntilChar)
+{
+ char From[_From_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (From, From_, _From_high+1);
+
+ while ((((*FromIndex) < FromHigh) && ((*ToIndex) < ToHigh)) && (From[(*FromIndex)] != UntilChar))
+ {
+ CopyChar ((const char *) From, _From_high, FromIndex, FromHigh, (char *) To, _To_high, ToIndex, ToHigh);
+ }
+}
+
+
+/*
+ CopyChar - copies a character from string From to string To and
+ takes into consideration escape characters. ie \x
+ Where x is any character.
+*/
+
+static void CopyChar (const char *From_, unsigned int _From_high, unsigned int *FromIndex, unsigned int FromHigh, char *To, unsigned int _To_high, unsigned int *ToIndex, unsigned int ToHigh)
+{
+ char From[_From_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (From, From_, _From_high+1);
+
+ if (((*FromIndex) < FromHigh) && ((*ToIndex) < ToHigh))
+ {
+ if (Escape (From[(*FromIndex)]))
+ {
+ /* Skip over Escape Character */
+ (*FromIndex) += 1;
+ }
+ if ((*FromIndex) < FromHigh)
+ {
+ /* Copy Normal Character */
+ To[(*ToIndex)] = From[(*FromIndex)];
+ (*ToIndex) += 1;
+ (*FromIndex) += 1;
+ }
+ }
+}
+
+static unsigned int Escape (char ch)
+{
+ return ch == esc;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+static unsigned int Space (char ch)
+{
+ return (ch == space) || (ch == tab);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+static unsigned int DoubleQuote (char ch)
+{
+ return ch == dquote;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+static unsigned int SingleQuote (char ch)
+{
+ return ch == squote;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetArg - takes a command line and attempts to extract argument, n,
+ from CmdLine. The resulting argument is placed into, a.
+ The result of the operation is returned.
+*/
+
+extern "C" unsigned int CmdArgs_GetArg (const char *CmdLine_, unsigned int _CmdLine_high, unsigned int n, char *Argi, unsigned int _Argi_high)
+{
+ unsigned int Index;
+ unsigned int i;
+ unsigned int Another;
+ char CmdLine[_CmdLine_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (CmdLine, CmdLine_, _CmdLine_high+1);
+
+ Index = 0;
+ /* Continually retrieve an argument until we get the n th argument. */
+ i = 0;
+ do {
+ Another = GetNextArg ((const char *) CmdLine, _CmdLine_high, &Index, (char *) Argi, _Argi_high);
+ i += 1;
+ } while (! ((i > n) || ! Another));
+ return i > n;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Narg - returns the number of arguments available from
+ command line, CmdLine.
+*/
+
+extern "C" unsigned int CmdArgs_Narg (const char *CmdLine_, unsigned int _CmdLine_high)
+{
+ typedef struct Narg__T1_a Narg__T1;
+
+ struct Narg__T1_a { char array[1000+1]; };
+ Narg__T1 a;
+ unsigned int ArgNo;
+ char CmdLine[_CmdLine_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (CmdLine, CmdLine_, _CmdLine_high+1);
+
+ ArgNo = 0;
+ while (CmdArgs_GetArg ((const char *) CmdLine, _CmdLine_high, ArgNo, (char *) &a.array[0], 1000))
+ {
+ ArgNo += 1;
+ }
+ /*
+ IF ArgNo>0
+ THEN
+ DEC(ArgNo)
+ END ;
+ */
+ return ArgNo;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_CmdArgs_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_CmdArgs_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GDebug.cc b/gcc/m2/mc-boot/GDebug.cc
new file mode 100644
index 00000000000..6329abb11b1
--- /dev/null
+++ b/gcc/m2/mc-boot/GDebug.cc
@@ -0,0 +1,168 @@
+/* do not edit automatically generated by mc from Debug. */
+/* Debug.mod provides some simple debugging routines.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _Debug_H
+#define _Debug_C
+
+# include "GASCII.h"
+# include "GNumberIO.h"
+# include "GStdIO.h"
+# include "Glibc.h"
+# include "GM2RTS.h"
+
+# define MaxNoOfDigits 12
+
+/*
+ Halt - writes a message in the format:
+ Module:Line:Message
+
+ It then terminates by calling HALT.
+*/
+
+extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, unsigned int LineNo, const char *Module_, unsigned int _Module_high);
+
+/*
+ DebugString - writes a string to the debugging device (Scn.Write).
+ It interprets
+ as carriage return, linefeed.
+*/
+
+extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high);
+
+/*
+ WriteLn - writes a carriage return and a newline
+ character.
+*/
+
+static void WriteLn (void);
+
+
+/*
+ WriteLn - writes a carriage return and a newline
+ character.
+*/
+
+static void WriteLn (void)
+{
+ StdIO_Write (ASCII_cr);
+ StdIO_Write (ASCII_lf);
+}
+
+
+/*
+ Halt - writes a message in the format:
+ Module:Line:Message
+
+ It then terminates by calling HALT.
+*/
+
+extern "C" void Debug_Halt (const char *Message_, unsigned int _Message_high, unsigned int LineNo, const char *Module_, unsigned int _Module_high)
+{
+ typedef struct Halt__T1_a Halt__T1;
+
+ struct Halt__T1_a { char array[MaxNoOfDigits+1]; };
+ Halt__T1 No;
+ char Message[_Message_high+1];
+ char Module[_Module_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (Message, Message_, _Message_high+1);
+ memcpy (Module, Module_, _Module_high+1);
+
+ Debug_DebugString ((const char *) Module, _Module_high); /* should be large enough for most source files.. */
+ NumberIO_CardToStr (LineNo, 0, (char *) &No.array[0], MaxNoOfDigits);
+ Debug_DebugString ((const char *) ":", 1);
+ Debug_DebugString ((const char *) &No.array[0], MaxNoOfDigits);
+ Debug_DebugString ((const char *) ":", 1);
+ Debug_DebugString ((const char *) Message, _Message_high);
+ Debug_DebugString ((const char *) "\\n", 2);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ DebugString - writes a string to the debugging device (Scn.Write).
+ It interprets
+ as carriage return, linefeed.
+*/
+
+extern "C" void Debug_DebugString (const char *a_, unsigned int _a_high)
+{
+ unsigned int n;
+ unsigned int high;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ high = _a_high;
+ n = 0;
+ while ((n <= high) && (a[n] != ASCII_nul))
+ {
+ if (a[n] == '\\')
+ {
+ /* avoid dangling else. */
+ if ((n+1) <= high)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (a[n+1] == 'n')
+ {
+ WriteLn ();
+ n += 1;
+ }
+ else if (a[n+1] == '\\')
+ {
+ /* avoid dangling else. */
+ StdIO_Write ('\\');
+ n += 1;
+ }
+ }
+ }
+ else
+ {
+ StdIO_Write (a[n]);
+ }
+ n += 1;
+ }
+}
+
+extern "C" void _M2_Debug_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Debug_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GDynamicStrings.cc b/gcc/m2/mc-boot/GDynamicStrings.cc
new file mode 100644
index 00000000000..dfc163646bb
--- /dev/null
+++ b/gcc/m2/mc-boot/GDynamicStrings.cc
@@ -0,0 +1,2676 @@
+/* do not edit automatically generated by mc from DynamicStrings. */
+/* DynamicStrings.mod provides a dynamic string type and procedures.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _DynamicStrings_H
+#define _DynamicStrings_C
+
+# include "Glibc.h"
+# include "GStrLib.h"
+# include "GStorage.h"
+# include "GAssertion.h"
+# include "GSYSTEM.h"
+# include "GASCII.h"
+# include "GM2RTS.h"
+
+# define MaxBuf 127
+# define PoisonOn FALSE
+# define DebugOn FALSE
+# define CheckOn FALSE
+# define TraceOn FALSE
+typedef struct DynamicStrings_Contents_r DynamicStrings_Contents;
+
+typedef struct DynamicStrings_DebugInfo_r DynamicStrings_DebugInfo;
+
+typedef struct DynamicStrings_stringRecord_r DynamicStrings_stringRecord;
+
+typedef struct DynamicStrings_descriptor_r DynamicStrings_descriptor;
+
+typedef DynamicStrings_descriptor *DynamicStrings_Descriptor;
+
+typedef struct DynamicStrings_frameRec_r DynamicStrings_frameRec;
+
+typedef DynamicStrings_frameRec *DynamicStrings_frame;
+
+typedef struct DynamicStrings__T3_a DynamicStrings__T3;
+
+typedef enum {DynamicStrings_inuse, DynamicStrings_marked, DynamicStrings_onlist, DynamicStrings_poisoned} DynamicStrings_desState;
+
+typedef DynamicStrings_stringRecord *DynamicStrings_String;
+
+struct DynamicStrings_DebugInfo_r {
+ DynamicStrings_String next;
+ void *file;
+ unsigned int line;
+ void *proc;
+ };
+
+struct DynamicStrings_descriptor_r {
+ unsigned int charStarUsed;
+ void *charStar;
+ unsigned int charStarSize;
+ unsigned int charStarValid;
+ DynamicStrings_desState state;
+ DynamicStrings_String garbage;
+ };
+
+struct DynamicStrings_frameRec_r {
+ DynamicStrings_String alloc;
+ DynamicStrings_String dealloc;
+ DynamicStrings_frame next;
+ };
+
+struct DynamicStrings__T3_a { char array[(MaxBuf-1)+1]; };
+struct DynamicStrings_Contents_r {
+ DynamicStrings__T3 buf;
+ unsigned int len;
+ DynamicStrings_String next;
+ };
+
+struct DynamicStrings_stringRecord_r {
+ DynamicStrings_Contents contents;
+ DynamicStrings_Descriptor head;
+ DynamicStrings_DebugInfo debug;
+ };
+
+static unsigned int Initialized;
+static DynamicStrings_frame frameHead;
+static DynamicStrings_String captured;
+
+/*
+ InitString - creates and returns a String type object.
+ Initial contents are, a.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high);
+
+/*
+ KillString - frees String, s, and its contents.
+ NIL is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s);
+
+/*
+ Fin - finishes with a string, it calls KillString with, s.
+ The purpose of the procedure is to provide a short cut
+ to calling KillString and then testing the return result.
+*/
+
+extern "C" void DynamicStrings_Fin (DynamicStrings_String s);
+
+/*
+ InitStringCharStar - initializes and returns a String to contain the C string.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a);
+
+/*
+ InitStringChar - initializes and returns a String to contain the single character, ch.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch);
+
+/*
+ Mark - marks String, s, ready for garbage collection.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s);
+
+/*
+ Length - returns the length of the String, s.
+*/
+
+extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s);
+
+/*
+ ConCat - returns String, a, after the contents of, b, have been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ ConCatChar - returns String, a, after character, ch, has been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch);
+
+/*
+ Assign - assigns the contents of, b, into, a.
+ String, a, is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ Dup - duplicate a String, s, returning the copy of s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s);
+
+/*
+ Add - returns a new String which contains the contents of a and b.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ Equal - returns TRUE if String, a, and, b, are equal.
+*/
+
+extern "C" unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ EqualCharStar - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a);
+
+/*
+ EqualArray - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high);
+
+/*
+ Mult - returns a new string which is n concatenations of String, s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n);
+
+/*
+ Slice - returns a new string which contains the elements
+ low..high-1
+
+ strings start at element 0
+ Slice(s, 0, 2) will return elements 0, 1 but not 2
+ Slice(s, 1, 3) will return elements 1, 2 but not 3
+ Slice(s, 2, 0) will return elements 2..max
+ Slice(s, 3, -1) will return elements 3..max-1
+ Slice(s, 4, -2) will return elements 4..max-2
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high);
+
+/*
+ Index - returns the indice of the first occurance of, ch, in
+ String, s. -1 is returned if, ch, does not exist.
+ The search starts at position, o.
+*/
+
+extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o);
+
+/*
+ RIndex - returns the indice of the last occurance of, ch,
+ in String, s. The search starts at position, o.
+ -1 is returned if, ch, is not found.
+*/
+
+extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o);
+
+/*
+ RemoveComment - assuming that, comment, is a comment delimiter
+ which indicates anything to its right is a comment
+ then strip off the comment and also any white space
+ on the remaining right hand side.
+ It leaves any white space on the left hand side alone.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment);
+
+/*
+ RemoveWhitePrefix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s);
+
+/*
+ RemoveWhitePostfix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s);
+
+/*
+ ToUpper - returns string, s, after it has had its lower case characters
+ replaced by upper case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s);
+
+/*
+ ToLower - returns string, s, after it has had its upper case characters
+ replaced by lower case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s);
+
+/*
+ CopyOut - copies string, s, to a.
+*/
+
+extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s);
+
+/*
+ char - returns the character, ch, at position, i, in String, s.
+*/
+
+extern "C" char DynamicStrings_char (DynamicStrings_String s, int i);
+
+/*
+ string - returns the C style char * of String, s.
+*/
+
+extern "C" void * DynamicStrings_string (DynamicStrings_String s);
+
+/*
+ InitStringDB - the debug version of InitString.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ InitStringCharStarDB - the debug version of InitStringCharStar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ InitStringCharDB - the debug version of InitStringChar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ MultDB - the debug version of MultDB.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ DupDB - the debug version of Dup.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ SliceDB - debug version of Slice.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line);
+
+/*
+ PushAllocation - pushes the current allocation/deallocation lists.
+*/
+
+extern "C" void DynamicStrings_PushAllocation (void);
+
+/*
+ PopAllocation - test to see that all strings are deallocated since
+ the last push. Then it pops to the previous
+ allocation/deallocation lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" void DynamicStrings_PopAllocation (unsigned int halt);
+
+/*
+ PopAllocationExemption - test to see that all strings are deallocated, except
+ string, e, since the last push.
+ Then it pops to the previous allocation/deallocation
+ lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e);
+
+/*
+ writeStringDesc write out debugging information about string, s. */
+
+static void writeStringDesc (DynamicStrings_String s);
+
+/*
+ writeNspace -
+*/
+
+static void writeNspace (unsigned int n);
+
+/*
+ DumpStringInfo -
+*/
+
+static void DumpStringInfo (DynamicStrings_String s, unsigned int i);
+
+/*
+ DumpStringInfo -
+*/
+
+static void stop (void);
+
+/*
+ doDSdbEnter -
+*/
+
+static void doDSdbEnter (void);
+
+/*
+ doDSdbExit -
+*/
+
+static void doDSdbExit (DynamicStrings_String s);
+
+/*
+ DSdbEnter -
+*/
+
+static void DSdbEnter (void);
+
+/*
+ DSdbExit -
+*/
+
+static void DSdbExit (DynamicStrings_String s);
+static unsigned int Capture (DynamicStrings_String s);
+
+/*
+ Min -
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b);
+
+/*
+ Max -
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b);
+
+/*
+ writeString - writes a string to stdout.
+*/
+
+static void writeString (const char *a_, unsigned int _a_high);
+
+/*
+ writeCstring - writes a C string to stdout.
+*/
+
+static void writeCstring (void * a);
+
+/*
+ writeCard -
+*/
+
+static void writeCard (unsigned int c);
+
+/*
+ writeLongcard -
+*/
+
+static void writeLongcard (long unsigned int l);
+
+/*
+ writeAddress -
+*/
+
+static void writeAddress (void * a);
+
+/*
+ writeLn - writes a newline.
+*/
+
+static void writeLn (void);
+
+/*
+ AssignDebug - assigns, file, and, line, information to string, s.
+*/
+
+static DynamicStrings_String AssignDebug (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line, const char *proc_, unsigned int _proc_high);
+
+/*
+ IsOn - returns TRUE if, s, is on one of the debug lists.
+*/
+
+static unsigned int IsOn (DynamicStrings_String list, DynamicStrings_String s);
+
+/*
+ AddTo - adds string, s, to, list.
+*/
+
+static void AddTo (DynamicStrings_String *list, DynamicStrings_String s);
+
+/*
+ SubFrom - removes string, s, from, list.
+*/
+
+static void SubFrom (DynamicStrings_String *list, DynamicStrings_String s);
+
+/*
+ AddAllocated - adds string, s, to the head of the allocated list.
+*/
+
+static void AddAllocated (DynamicStrings_String s);
+
+/*
+ AddDeallocated - adds string, s, to the head of the deallocated list.
+*/
+
+static void AddDeallocated (DynamicStrings_String s);
+
+/*
+ IsOnAllocated - returns TRUE if the string, s, has ever been allocated.
+*/
+
+static unsigned int IsOnAllocated (DynamicStrings_String s);
+
+/*
+ IsOnDeallocated - returns TRUE if the string, s, has ever been deallocated.
+*/
+
+static unsigned int IsOnDeallocated (DynamicStrings_String s);
+
+/*
+ SubAllocated - removes string, s, from the list of allocated strings.
+*/
+
+static void SubAllocated (DynamicStrings_String s);
+
+/*
+ SubDeallocated - removes string, s, from the list of deallocated strings.
+*/
+
+static void SubDeallocated (DynamicStrings_String s);
+
+/*
+ SubDebugInfo - removes string, s, from the list of allocated strings.
+*/
+
+static void SubDebugInfo (DynamicStrings_String s);
+
+/*
+ AddDebugInfo - adds string, s, to the list of allocated strings.
+*/
+
+static void AddDebugInfo (DynamicStrings_String s);
+
+/*
+ ConcatContents - add the contents of string, a, where, h, is the
+ total length of, a. The offset is in, o.
+*/
+
+static void ConcatContents (DynamicStrings_Contents *c, const char *a_, unsigned int _a_high, unsigned int h, unsigned int o);
+
+/*
+ DeallocateCharStar - deallocates any charStar.
+*/
+
+static void DeallocateCharStar (DynamicStrings_String s);
+
+/*
+ CheckPoisoned - checks for a poisoned string, s.
+*/
+
+static DynamicStrings_String CheckPoisoned (DynamicStrings_String s);
+
+/*
+ MarkInvalid - marks the char * version of String, s, as invalid.
+*/
+
+static void MarkInvalid (DynamicStrings_String s);
+
+/*
+ ConcatContentsAddress - concatenate the string, a, where, h, is the
+ total length of, a.
+*/
+
+static void ConcatContentsAddress (DynamicStrings_Contents *c, void * a, unsigned int h);
+
+/*
+ AddToGarbage - adds String, b, onto the garbage list of, a. Providing
+ the state of b is marked. The state is then altered to
+ onlist. String, a, is returned.
+*/
+
+static DynamicStrings_String AddToGarbage (DynamicStrings_String a, DynamicStrings_String b);
+
+/*
+ IsOnGarbage - returns TRUE if, s, is on string, e, garbage list.
+*/
+
+static unsigned int IsOnGarbage (DynamicStrings_String e, DynamicStrings_String s);
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch);
+
+/*
+ DumpState -
+*/
+
+static void DumpState (DynamicStrings_String s);
+
+/*
+ DumpStringSynopsis -
+*/
+
+static void DumpStringSynopsis (DynamicStrings_String s);
+
+/*
+ DumpString - displays the contents of string, s.
+*/
+
+static void DumpString (DynamicStrings_String s);
+
+/*
+ Init - initialize the module.
+*/
+
+static void Init (void);
+
+
+/*
+ writeStringDesc write out debugging information about string, s. */
+
+static void writeStringDesc (DynamicStrings_String s)
+{
+ writeCstring (s->debug.file);
+ writeString ((const char *) ":", 1);
+ writeCard (s->debug.line);
+ writeString ((const char *) ":", 1);
+ writeCstring (s->debug.proc);
+ writeString ((const char *) " ", 1);
+ writeAddress (reinterpret_cast<void *> (s));
+ writeString ((const char *) " ", 1);
+ switch (s->head->state)
+ {
+ case DynamicStrings_inuse:
+ writeString ((const char *) "still in use (", 14);
+ writeCard (s->contents.len);
+ writeString ((const char *) ") characters", 12);
+ break;
+
+ case DynamicStrings_marked:
+ writeString ((const char *) "marked", 6);
+ break;
+
+ case DynamicStrings_onlist:
+ writeString ((const char *) "on a (lost) garbage list", 24);
+ break;
+
+ case DynamicStrings_poisoned:
+ writeString ((const char *) "poisoned", 8);
+ break;
+
+
+ default:
+ writeString ((const char *) "unknown state", 13);
+ break;
+ }
+}
+
+
+/*
+ writeNspace -
+*/
+
+static void writeNspace (unsigned int n)
+{
+ while (n > 0)
+ {
+ writeString ((const char *) " ", 1);
+ n -= 1;
+ }
+}
+
+
+/*
+ DumpStringInfo -
+*/
+
+static void DumpStringInfo (DynamicStrings_String s, unsigned int i)
+{
+ DynamicStrings_String t;
+
+ if (s != NULL)
+ {
+ writeNspace (i);
+ writeStringDesc (s);
+ writeLn ();
+ if (s->head->garbage != NULL)
+ {
+ writeNspace (i);
+ writeString ((const char *) "garbage list:", 13);
+ writeLn ();
+ do {
+ s = s->head->garbage;
+ DumpStringInfo (s, i+1);
+ writeLn ();
+ } while (! (s == NULL));
+ }
+ }
+}
+
+
+/*
+ DumpStringInfo -
+*/
+
+static void stop (void)
+{
+}
+
+
+/*
+ doDSdbEnter -
+*/
+
+static void doDSdbEnter (void)
+{
+ if (CheckOn)
+ {
+ DynamicStrings_PushAllocation ();
+ }
+}
+
+
+/*
+ doDSdbExit -
+*/
+
+static void doDSdbExit (DynamicStrings_String s)
+{
+ if (CheckOn)
+ {
+ s = DynamicStrings_PopAllocationExemption (TRUE, s);
+ }
+}
+
+
+/*
+ DSdbEnter -
+*/
+
+static void DSdbEnter (void)
+{
+}
+
+
+/*
+ DSdbExit -
+*/
+
+static void DSdbExit (DynamicStrings_String s)
+{
+}
+
+static unsigned int Capture (DynamicStrings_String s)
+{
+ /*
+ * #undef GM2_DEBUG_DYNAMICSTINGS
+ * #if defined(GM2_DEBUG_DYNAMICSTINGS)
+ * # define DSdbEnter doDSdbEnter
+ * # define DSdbExit doDSdbExit
+ * # define CheckOn TRUE
+ * # define TraceOn TRUE
+ * #endif
+ */
+ captured = s;
+ return 1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Min -
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Max -
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ writeString - writes a string to stdout.
+*/
+
+static void writeString (const char *a_, unsigned int _a_high)
+{
+ int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ i = static_cast<int> (libc_write (1, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
+}
+
+
+/*
+ writeCstring - writes a C string to stdout.
+*/
+
+static void writeCstring (void * a)
+{
+ int i;
+
+ if (a == NULL)
+ {
+ writeString ((const char *) "(null)", 6);
+ }
+ else
+ {
+ i = static_cast<int> (libc_write (1, a, libc_strlen (a)));
+ }
+}
+
+
+/*
+ writeCard -
+*/
+
+static void writeCard (unsigned int c)
+{
+ char ch;
+ int i;
+
+ if (c > 9)
+ {
+ writeCard (c / 10);
+ writeCard (c % 10);
+ }
+ else
+ {
+ ch = ((char) ( ((unsigned int) ('0'))+c));
+ i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (1)));
+ }
+}
+
+
+/*
+ writeLongcard -
+*/
+
+static void writeLongcard (long unsigned int l)
+{
+ char ch;
+ int i;
+
+ if (l > 16)
+ {
+ writeLongcard (l / 16);
+ writeLongcard (l % 16);
+ }
+ else if (l < 10)
+ {
+ /* avoid dangling else. */
+ ch = ((char) ( ((unsigned int) ('0'))+((unsigned int ) (l))));
+ i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (1)));
+ }
+ else if (l < 16)
+ {
+ /* avoid dangling else. */
+ ch = ((char) (( ((unsigned int) ('a'))+((unsigned int ) (l)))-10));
+ i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (1)));
+ }
+}
+
+
+/*
+ writeAddress -
+*/
+
+static void writeAddress (void * a)
+{
+ writeLongcard ((long unsigned int ) (a));
+}
+
+
+/*
+ writeLn - writes a newline.
+*/
+
+static void writeLn (void)
+{
+ char ch;
+ int i;
+
+ ch = ASCII_lf;
+ i = static_cast<int> (libc_write (1, &ch, static_cast<size_t> (1)));
+}
+
+
+/*
+ AssignDebug - assigns, file, and, line, information to string, s.
+*/
+
+static DynamicStrings_String AssignDebug (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line, const char *proc_, unsigned int _proc_high)
+{
+ void * f;
+ void * p;
+ char file[_file_high+1];
+ char proc[_proc_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+ memcpy (proc, proc_, _proc_high+1);
+
+ f = &file;
+ p = &proc;
+ Storage_ALLOCATE (&s->debug.file, (StrLib_StrLen ((const char *) file, _file_high))+1);
+ if ((libc_strncpy (s->debug.file, f, (StrLib_StrLen ((const char *) file, _file_high))+1)) == NULL)
+ {} /* empty. */
+ s->debug.line = line;
+ Storage_ALLOCATE (&s->debug.proc, (StrLib_StrLen ((const char *) proc, _proc_high))+1);
+ if ((libc_strncpy (s->debug.proc, p, (StrLib_StrLen ((const char *) proc, _proc_high))+1)) == NULL)
+ {} /* empty. */
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsOn - returns TRUE if, s, is on one of the debug lists.
+*/
+
+static unsigned int IsOn (DynamicStrings_String list, DynamicStrings_String s)
+{
+ while ((list != s) && (list != NULL))
+ {
+ list = list->debug.next;
+ }
+ return list == s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ AddTo - adds string, s, to, list.
+*/
+
+static void AddTo (DynamicStrings_String *list, DynamicStrings_String s)
+{
+ if ((*list) == NULL)
+ {
+ (*list) = s;
+ s->debug.next = NULL;
+ }
+ else
+ {
+ s->debug.next = (*list);
+ (*list) = s;
+ }
+}
+
+
+/*
+ SubFrom - removes string, s, from, list.
+*/
+
+static void SubFrom (DynamicStrings_String *list, DynamicStrings_String s)
+{
+ DynamicStrings_String p;
+
+ if ((*list) == s)
+ {
+ (*list) = s->debug.next;
+ }
+ else
+ {
+ p = (*list);
+ while ((p->debug.next != NULL) && (p->debug.next != s))
+ {
+ p = p->debug.next;
+ }
+ if (p->debug.next == s)
+ {
+ p->debug.next = s->debug.next;
+ }
+ else
+ {
+ /* not found, quit */
+ return ;
+ }
+ }
+ s->debug.next = NULL;
+}
+
+
+/*
+ AddAllocated - adds string, s, to the head of the allocated list.
+*/
+
+static void AddAllocated (DynamicStrings_String s)
+{
+ Init ();
+ AddTo (&frameHead->alloc, s);
+}
+
+
+/*
+ AddDeallocated - adds string, s, to the head of the deallocated list.
+*/
+
+static void AddDeallocated (DynamicStrings_String s)
+{
+ Init ();
+ AddTo (&frameHead->dealloc, s);
+}
+
+
+/*
+ IsOnAllocated - returns TRUE if the string, s, has ever been allocated.
+*/
+
+static unsigned int IsOnAllocated (DynamicStrings_String s)
+{
+ DynamicStrings_frame f;
+
+ Init ();
+ f = frameHead;
+ do {
+ if (IsOn (f->alloc, s))
+ {
+ return TRUE;
+ }
+ else
+ {
+ f = f->next;
+ }
+ } while (! (f == NULL));
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsOnDeallocated - returns TRUE if the string, s, has ever been deallocated.
+*/
+
+static unsigned int IsOnDeallocated (DynamicStrings_String s)
+{
+ DynamicStrings_frame f;
+
+ Init ();
+ f = frameHead;
+ do {
+ if (IsOn (f->dealloc, s))
+ {
+ return TRUE;
+ }
+ else
+ {
+ f = f->next;
+ }
+ } while (! (f == NULL));
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SubAllocated - removes string, s, from the list of allocated strings.
+*/
+
+static void SubAllocated (DynamicStrings_String s)
+{
+ DynamicStrings_frame f;
+
+ Init ();
+ f = frameHead;
+ do {
+ if (IsOn (f->alloc, s))
+ {
+ SubFrom (&f->alloc, s);
+ return ;
+ }
+ else
+ {
+ f = f->next;
+ }
+ } while (! (f == NULL));
+}
+
+
+/*
+ SubDeallocated - removes string, s, from the list of deallocated strings.
+*/
+
+static void SubDeallocated (DynamicStrings_String s)
+{
+ DynamicStrings_frame f;
+
+ Init ();
+ f = frameHead;
+ do {
+ if (IsOn (f->dealloc, s))
+ {
+ SubFrom (&f->dealloc, s);
+ return ;
+ }
+ else
+ {
+ f = f->next;
+ }
+ } while (! (f == NULL));
+}
+
+
+/*
+ SubDebugInfo - removes string, s, from the list of allocated strings.
+*/
+
+static void SubDebugInfo (DynamicStrings_String s)
+{
+ if (IsOnDeallocated (s))
+ {
+ Assertion_Assert (! DebugOn);
+ /* string has already been deallocated */
+ return ;
+ }
+ if (IsOnAllocated (s))
+ {
+ SubAllocated (s);
+ AddDeallocated (s);
+ }
+ else
+ {
+ /* string has not been allocated */
+ Assertion_Assert (! DebugOn);
+ }
+}
+
+
+/*
+ AddDebugInfo - adds string, s, to the list of allocated strings.
+*/
+
+static void AddDebugInfo (DynamicStrings_String s)
+{
+ s->debug.next = NULL;
+ s->debug.file = NULL;
+ s->debug.line = 0;
+ s->debug.proc = NULL;
+ if (CheckOn)
+ {
+ AddAllocated (s);
+ }
+}
+
+
+/*
+ ConcatContents - add the contents of string, a, where, h, is the
+ total length of, a. The offset is in, o.
+*/
+
+static void ConcatContents (DynamicStrings_Contents *c, const char *a_, unsigned int _a_high, unsigned int h, unsigned int o)
+{
+ unsigned int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ i = (*c).len;
+ while ((o < h) && (i < MaxBuf))
+ {
+ (*c).buf.array[i] = a[o];
+ o += 1;
+ i += 1;
+ }
+ if (o < h)
+ {
+ (*c).len = MaxBuf;
+ Storage_ALLOCATE ((void **) &(*c).next, sizeof (DynamicStrings_stringRecord));
+ (*c).next->head = NULL;
+ (*c).next->contents.len = 0;
+ (*c).next->contents.next = NULL;
+ ConcatContents (&(*c).next->contents, (const char *) a, _a_high, h, o);
+ AddDebugInfo ((*c).next);
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 722, (const char *) "ConcatContents", 14);
+ }
+ else
+ {
+ (*c).len = i;
+ }
+}
+
+
+/*
+ DeallocateCharStar - deallocates any charStar.
+*/
+
+static void DeallocateCharStar (DynamicStrings_String s)
+{
+ if ((s != NULL) && (s->head != NULL))
+ {
+ if (s->head->charStarUsed && (s->head->charStar != NULL))
+ {
+ Storage_DEALLOCATE (&s->head->charStar, s->head->charStarSize);
+ }
+ s->head->charStarUsed = FALSE;
+ s->head->charStar = NULL;
+ s->head->charStarSize = 0;
+ s->head->charStarValid = FALSE;
+ }
+}
+
+
+/*
+ CheckPoisoned - checks for a poisoned string, s.
+*/
+
+static DynamicStrings_String CheckPoisoned (DynamicStrings_String s)
+{
+ if (((PoisonOn && (s != NULL)) && (s->head != NULL)) && (s->head->state == DynamicStrings_poisoned))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ MarkInvalid - marks the char * version of String, s, as invalid.
+*/
+
+static void MarkInvalid (DynamicStrings_String s)
+{
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (s->head != NULL)
+ {
+ s->head->charStarValid = FALSE;
+ }
+}
+
+
+/*
+ ConcatContentsAddress - concatenate the string, a, where, h, is the
+ total length of, a.
+*/
+
+static void ConcatContentsAddress (DynamicStrings_Contents *c, void * a, unsigned int h)
+{
+ typedef char *ConcatContentsAddress__T1;
+
+ ConcatContentsAddress__T1 p;
+ unsigned int i;
+ unsigned int j;
+
+ j = 0;
+ i = (*c).len;
+ p = static_cast<ConcatContentsAddress__T1> (a);
+ while ((j < h) && (i < MaxBuf))
+ {
+ (*c).buf.array[i] = (*p);
+ i += 1;
+ j += 1;
+ p += 1;
+ }
+ if (j < h)
+ {
+ /* avoid dangling else. */
+ (*c).len = MaxBuf;
+ Storage_ALLOCATE ((void **) &(*c).next, sizeof (DynamicStrings_stringRecord));
+ (*c).next->head = NULL;
+ (*c).next->contents.len = 0;
+ (*c).next->contents.next = NULL;
+ ConcatContentsAddress (&(*c).next->contents, reinterpret_cast<void *> (p), h-j);
+ AddDebugInfo ((*c).next);
+ if (TraceOn)
+ {
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 917, (const char *) "ConcatContentsAddress", 21);
+ }
+ }
+ else
+ {
+ (*c).len = i;
+ (*c).next = NULL;
+ }
+}
+
+
+/*
+ AddToGarbage - adds String, b, onto the garbage list of, a. Providing
+ the state of b is marked. The state is then altered to
+ onlist. String, a, is returned.
+*/
+
+static DynamicStrings_String AddToGarbage (DynamicStrings_String a, DynamicStrings_String b)
+{
+ DynamicStrings_String c;
+
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ /*
+ IF (a#NIL) AND (a#b) AND (a^.head^.state=marked)
+ THEN
+ writeString('warning trying to add to a marked string') ; writeLn
+ END ;
+ */
+ if (((((a != b) && (a != NULL)) && (b != NULL)) && (b->head->state == DynamicStrings_marked)) && (a->head->state == DynamicStrings_inuse))
+ {
+ c = a;
+ while (c->head->garbage != NULL)
+ {
+ c = c->head->garbage;
+ }
+ c->head->garbage = b;
+ b->head->state = DynamicStrings_onlist;
+ if (CheckOn)
+ {
+ SubDebugInfo (b);
+ }
+ }
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsOnGarbage - returns TRUE if, s, is on string, e, garbage list.
+*/
+
+static unsigned int IsOnGarbage (DynamicStrings_String e, DynamicStrings_String s)
+{
+ if ((e != NULL) && (s != NULL))
+ {
+ while (e->head->garbage != NULL)
+ {
+ if (e->head->garbage == s)
+ {
+ return TRUE;
+ }
+ else
+ {
+ e = e->head->garbage;
+ }
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch)
+{
+ return (ch == ' ') || (ch == ASCII_tab);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DumpState -
+*/
+
+static void DumpState (DynamicStrings_String s)
+{
+ switch (s->head->state)
+ {
+ case DynamicStrings_inuse:
+ writeString ((const char *) "still in use (", 14);
+ writeCard (s->contents.len);
+ writeString ((const char *) ") characters", 12);
+ break;
+
+ case DynamicStrings_marked:
+ writeString ((const char *) "marked", 6);
+ break;
+
+ case DynamicStrings_onlist:
+ writeString ((const char *) "on a garbage list", 17);
+ break;
+
+ case DynamicStrings_poisoned:
+ writeString ((const char *) "poisoned", 8);
+ break;
+
+
+ default:
+ writeString ((const char *) "unknown state", 13);
+ break;
+ }
+}
+
+
+/*
+ DumpStringSynopsis -
+*/
+
+static void DumpStringSynopsis (DynamicStrings_String s)
+{
+ writeCstring (s->debug.file);
+ writeString ((const char *) ":", 1);
+ writeCard (s->debug.line);
+ writeString ((const char *) ":", 1);
+ writeCstring (s->debug.proc);
+ writeString ((const char *) " string ", 8);
+ writeAddress (reinterpret_cast<void *> (s));
+ writeString ((const char *) " ", 1);
+ DumpState (s);
+ if (IsOnAllocated (s))
+ {
+ writeString ((const char *) " globally allocated", 19);
+ }
+ else if (IsOnDeallocated (s))
+ {
+ /* avoid dangling else. */
+ writeString ((const char *) " globally deallocated", 21);
+ }
+ else
+ {
+ /* avoid dangling else. */
+ writeString ((const char *) " globally unknown", 17);
+ }
+ writeLn ();
+}
+
+
+/*
+ DumpString - displays the contents of string, s.
+*/
+
+static void DumpString (DynamicStrings_String s)
+{
+ DynamicStrings_String t;
+
+ if (s != NULL)
+ {
+ DumpStringSynopsis (s);
+ if ((s->head != NULL) && (s->head->garbage != NULL))
+ {
+ writeString ((const char *) "display chained strings on the garbage list", 43);
+ writeLn ();
+ t = s->head->garbage;
+ while (t != NULL)
+ {
+ DumpStringSynopsis (t);
+ t = t->head->garbage;
+ }
+ }
+ }
+}
+
+
+/*
+ Init - initialize the module.
+*/
+
+static void Init (void)
+{
+ if (! Initialized)
+ {
+ Initialized = TRUE;
+ frameHead = NULL;
+ DynamicStrings_PushAllocation ();
+ }
+}
+
+
+/*
+ InitString - creates and returns a String type object.
+ Initial contents are, a.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsigned int _a_high)
+{
+ DynamicStrings_String s;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ Storage_ALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord));
+ s->contents.len = 0;
+ s->contents.next = NULL;
+ ConcatContents (&s->contents, (const char *) a, _a_high, StrLib_StrLen ((const char *) a, _a_high), 0);
+ Storage_ALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor));
+ s->head->charStarUsed = FALSE;
+ s->head->charStar = NULL;
+ s->head->charStarSize = 0;
+ s->head->charStarValid = FALSE;
+ s->head->garbage = NULL;
+ s->head->state = DynamicStrings_inuse;
+ AddDebugInfo (s);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 758, (const char *) "InitString", 10);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillString - frees String, s, and its contents.
+ NIL is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_KillString (DynamicStrings_String s)
+{
+ DynamicStrings_String t;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (s != NULL)
+ {
+ if (CheckOn)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (IsOnAllocated (s))
+ {
+ SubAllocated (s);
+ }
+ else if (IsOnDeallocated (s))
+ {
+ /* avoid dangling else. */
+ SubDeallocated (s);
+ }
+ }
+ if (s->head != NULL)
+ {
+ s->head->state = DynamicStrings_poisoned;
+ s->head->garbage = DynamicStrings_KillString (s->head->garbage);
+ if (! PoisonOn)
+ {
+ DeallocateCharStar (s);
+ }
+ if (! PoisonOn)
+ {
+ Storage_DEALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor));
+ s->head = NULL;
+ }
+ }
+ t = DynamicStrings_KillString (s->contents.next);
+ if (! PoisonOn)
+ {
+ Storage_DEALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord));
+ }
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Fin - finishes with a string, it calls KillString with, s.
+ The purpose of the procedure is to provide a short cut
+ to calling KillString and then testing the return result.
+*/
+
+extern "C" void DynamicStrings_Fin (DynamicStrings_String s)
+{
+ if ((DynamicStrings_KillString (s)) != NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ InitStringCharStar - initializes and returns a String to contain the C string.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a)
+{
+ DynamicStrings_String s;
+
+ Storage_ALLOCATE ((void **) &s, sizeof (DynamicStrings_stringRecord));
+ s->contents.len = 0;
+ s->contents.next = NULL;
+ if (a != NULL)
+ {
+ ConcatContentsAddress (&s->contents, a, static_cast<unsigned int> (libc_strlen (a)));
+ }
+ Storage_ALLOCATE ((void **) &s->head, sizeof (DynamicStrings_descriptor));
+ s->head->charStarUsed = FALSE;
+ s->head->charStar = NULL;
+ s->head->charStarSize = 0;
+ s->head->charStarValid = FALSE;
+ s->head->garbage = NULL;
+ s->head->state = DynamicStrings_inuse;
+ AddDebugInfo (s);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 957, (const char *) "InitStringCharStar", 18);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitStringChar - initializes and returns a String to contain the single character, ch.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch)
+{
+ typedef struct InitStringChar__T4_a InitStringChar__T4;
+
+ struct InitStringChar__T4_a { char array[1+1]; };
+ InitStringChar__T4 a;
+ DynamicStrings_String s;
+
+ a.array[0] = ch;
+ a.array[1] = ASCII_nul;
+ s = DynamicStrings_InitString ((const char *) &a.array[0], 1);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 977, (const char *) "InitStringChar", 14);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Mark - marks String, s, ready for garbage collection.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mark (DynamicStrings_String s)
+{
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if ((s != NULL) && (s->head->state == DynamicStrings_inuse))
+ {
+ s->head->state = DynamicStrings_marked;
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Length - returns the length of the String, s.
+*/
+
+extern "C" unsigned int DynamicStrings_Length (DynamicStrings_String s)
+{
+ if (s == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ return s->contents.len+(DynamicStrings_Length (s->contents.next));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConCat - returns String, a, after the contents of, b, have been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCat (DynamicStrings_String a, DynamicStrings_String b)
+{
+ DynamicStrings_String t;
+
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ if (a == b)
+ {
+ return DynamicStrings_ConCat (a, DynamicStrings_Mark (DynamicStrings_Dup (b)));
+ }
+ else if (a != NULL)
+ {
+ /* avoid dangling else. */
+ a = AddToGarbage (a, b);
+ MarkInvalid (a);
+ t = a;
+ while (b != NULL)
+ {
+ while ((t->contents.len == MaxBuf) && (t->contents.next != NULL))
+ {
+ t = t->contents.next;
+ }
+ ConcatContents (&t->contents, (const char *) &b->contents.buf.array[0], (MaxBuf-1), b->contents.len, 0);
+ b = b->contents.next;
+ }
+ }
+ if ((a == NULL) && (b != NULL))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConCatChar - returns String, a, after character, ch, has been appended.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, char ch)
+{
+ typedef struct ConCatChar__T5_a ConCatChar__T5;
+
+ struct ConCatChar__T5_a { char array[1+1]; };
+ ConCatChar__T5 b;
+ DynamicStrings_String t;
+
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ }
+ b.array[0] = ch;
+ b.array[1] = ASCII_nul;
+ t = a;
+ MarkInvalid (a);
+ while ((t->contents.len == MaxBuf) && (t->contents.next != NULL))
+ {
+ t = t->contents.next;
+ }
+ ConcatContents (&t->contents, (const char *) &b.array[0], 1, 1, 0);
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Assign - assigns the contents of, b, into, a.
+ String, a, is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b)
+{
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ if ((a != NULL) && (b != NULL))
+ {
+ a->contents.next = DynamicStrings_KillString (a->contents.next);
+ a->contents.len = 0;
+ }
+ return DynamicStrings_ConCat (a, b);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Dup - duplicate a String, s, returning the copy of s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s)
+{
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ s = DynamicStrings_Assign (DynamicStrings_InitString ((const char *) "", 0), s);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1173, (const char *) "Dup", 3);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Add - returns a new String which contains the contents of a and b.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, DynamicStrings_String b)
+{
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ a = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "", 0), a), b);
+ if (TraceOn)
+ {
+ a = AssignDebug (a, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1193, (const char *) "Add", 3);
+ }
+ return a;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Equal - returns TRUE if String, a, and, b, are equal.
+*/
+
+extern "C" unsigned int DynamicStrings_Equal (DynamicStrings_String a, DynamicStrings_String b)
+{
+ unsigned int i;
+
+ if (PoisonOn)
+ {
+ a = CheckPoisoned (a);
+ b = CheckPoisoned (b);
+ }
+ if ((DynamicStrings_Length (a)) == (DynamicStrings_Length (b)))
+ {
+ while ((a != NULL) && (b != NULL))
+ {
+ i = 0;
+ Assertion_Assert (a->contents.len == b->contents.len);
+ while (i < a->contents.len)
+ {
+ if (a->contents.buf.array[i] != b->contents.buf.array[i])
+ {
+ return FALSE;
+ }
+ i += 1;
+ }
+ a = a->contents.next;
+ b = b->contents.next;
+ }
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EqualCharStar - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a)
+{
+ DynamicStrings_String t;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ t = DynamicStrings_InitStringCharStar (a);
+ if (TraceOn)
+ {
+ t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1250, (const char *) "EqualCharStar", 13);
+ }
+ t = AddToGarbage (t, s);
+ if (DynamicStrings_Equal (t, s))
+ {
+ t = DynamicStrings_KillString (t);
+ return TRUE;
+ }
+ else
+ {
+ t = DynamicStrings_KillString (t);
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EqualArray - returns TRUE if contents of String, s, is the same as the
+ string, a.
+*/
+
+extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, const char *a_, unsigned int _a_high)
+{
+ DynamicStrings_String t;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ t = DynamicStrings_InitString ((const char *) a, _a_high);
+ if (TraceOn)
+ {
+ t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1280, (const char *) "EqualArray", 10);
+ }
+ t = AddToGarbage (t, s);
+ if (DynamicStrings_Equal (t, s))
+ {
+ t = DynamicStrings_KillString (t);
+ return TRUE;
+ }
+ else
+ {
+ t = DynamicStrings_KillString (t);
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Mult - returns a new string which is n concatenations of String, s.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, unsigned int n)
+{
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (n <= 0)
+ {
+ s = AddToGarbage (DynamicStrings_InitString ((const char *) "", 0), s);
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_Mult (s, n-1), s);
+ }
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1312, (const char *) "Mult", 4);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Slice - returns a new string which contains the elements
+ low..high-1
+
+ strings start at element 0
+ Slice(s, 0, 2) will return elements 0, 1 but not 2
+ Slice(s, 1, 3) will return elements 1, 2 but not 3
+ Slice(s, 2, 0) will return elements 2..max
+ Slice(s, 3, -1) will return elements 3..max-1
+ Slice(s, 4, -2) will return elements 4..max-2
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, int low, int high)
+{
+ DynamicStrings_String d;
+ DynamicStrings_String t;
+ int start;
+ int end;
+ int o;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (low < 0)
+ {
+ low = ((int ) (DynamicStrings_Length (s)))+low;
+ }
+ if (high <= 0)
+ {
+ high = ((int ) (DynamicStrings_Length (s)))+high;
+ }
+ else
+ {
+ /* make sure high is <= Length (s) */
+ high = Min (DynamicStrings_Length (s), static_cast<unsigned int> (high));
+ }
+ d = DynamicStrings_InitString ((const char *) "", 0);
+ d = AddToGarbage (d, s);
+ o = 0;
+ t = d;
+ while (s != NULL)
+ {
+ if (low < (o+((int ) (s->contents.len))))
+ {
+ if (o > high)
+ {
+ s = NULL;
+ }
+ else
+ {
+ /* found sliceable unit */
+ if (low < o)
+ {
+ start = 0;
+ }
+ else
+ {
+ start = low-o;
+ }
+ end = Max (Min (MaxBuf, static_cast<unsigned int> (high-o)), 0);
+ while (t->contents.len == MaxBuf)
+ {
+ if (t->contents.next == NULL)
+ {
+ Storage_ALLOCATE ((void **) &t->contents.next, sizeof (DynamicStrings_stringRecord));
+ t->contents.next->head = NULL;
+ t->contents.next->contents.len = 0;
+ AddDebugInfo (t->contents.next);
+ if (TraceOn)
+ {
+ t->contents.next = AssignDebug (t->contents.next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1380, (const char *) "Slice", 5);
+ }
+ }
+ t = t->contents.next;
+ }
+ ConcatContentsAddress (&t->contents, &s->contents.buf.array[start], static_cast<unsigned int> (end-start));
+ o += s->contents.len;
+ s = s->contents.next;
+ }
+ }
+ else
+ {
+ o += s->contents.len;
+ s = s->contents.next;
+ }
+ }
+ if (TraceOn)
+ {
+ d = AssignDebug (d, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1397, (const char *) "Slice", 5);
+ }
+ return d;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Index - returns the indice of the first occurance of, ch, in
+ String, s. -1 is returned if, ch, does not exist.
+ The search starts at position, o.
+*/
+
+extern "C" int DynamicStrings_Index (DynamicStrings_String s, char ch, unsigned int o)
+{
+ unsigned int i;
+ unsigned int k;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ k = 0;
+ while (s != NULL)
+ {
+ if ((k+s->contents.len) < o)
+ {
+ k += s->contents.len;
+ }
+ else
+ {
+ i = o-k;
+ while (i < s->contents.len)
+ {
+ if (s->contents.buf.array[i] == ch)
+ {
+ return k+i;
+ }
+ i += 1;
+ }
+ k += i;
+ o = k;
+ }
+ s = s->contents.next;
+ }
+ return -1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RIndex - returns the indice of the last occurance of, ch,
+ in String, s. The search starts at position, o.
+ -1 is returned if, ch, is not found.
+*/
+
+extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned int o)
+{
+ unsigned int i;
+ unsigned int k;
+ int j;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ j = -1;
+ k = 0;
+ while (s != NULL)
+ {
+ if ((k+s->contents.len) < o)
+ {
+ k += s->contents.len;
+ }
+ else
+ {
+ if (o < k)
+ {
+ i = 0;
+ }
+ else
+ {
+ i = o-k;
+ }
+ while (i < s->contents.len)
+ {
+ if (s->contents.buf.array[i] == ch)
+ {
+ j = k;
+ }
+ k += 1;
+ i += 1;
+ }
+ }
+ s = s->contents.next;
+ }
+ return j;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RemoveComment - assuming that, comment, is a comment delimiter
+ which indicates anything to its right is a comment
+ then strip off the comment and also any white space
+ on the remaining right hand side.
+ It leaves any white space on the left hand side alone.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_String s, char comment)
+{
+ int i;
+
+ i = DynamicStrings_Index (s, comment, 0);
+ if (i == 0)
+ {
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ }
+ else if (i > 0)
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_RemoveWhitePostfix (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i));
+ }
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1509, (const char *) "RemoveComment", 13);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RemoveWhitePrefix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicStrings_String s)
+{
+ unsigned int i;
+
+ i = 0;
+ while (IsWhite (DynamicStrings_char (s, static_cast<int> (i))))
+ {
+ i += 1;
+ }
+ s = DynamicStrings_Slice (s, (int ) (i), 0);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1621, (const char *) "RemoveWhitePrefix", 17);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RemoveWhitePostfix - removes any leading white space from String, s.
+ A new string is returned.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrings_String s)
+{
+ int i;
+
+ i = ((int ) (DynamicStrings_Length (s)))-1;
+ while ((i >= 0) && (IsWhite (DynamicStrings_char (s, i))))
+ {
+ i -= 1;
+ }
+ s = DynamicStrings_Slice (s, 0, i+1);
+ if (TraceOn)
+ {
+ s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1643, (const char *) "RemoveWhitePostfix", 18);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ToUpper - returns string, s, after it has had its lower case characters
+ replaced by upper case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToUpper (DynamicStrings_String s)
+{
+ char ch;
+ unsigned int i;
+ DynamicStrings_String t;
+
+ if (s != NULL)
+ {
+ MarkInvalid (s);
+ t = s;
+ while (t != NULL)
+ {
+ i = 0;
+ while (i < t->contents.len)
+ {
+ ch = t->contents.buf.array[i];
+ if ((ch >= 'a') && (ch <= 'z'))
+ {
+ t->contents.buf.array[i] = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('a')))+ ((unsigned int) ('A'))));
+ }
+ i += 1;
+ }
+ t = t->contents.next;
+ }
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ToLower - returns string, s, after it has had its upper case characters
+ replaced by lower case characters.
+ The string, s, is not duplicated.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_ToLower (DynamicStrings_String s)
+{
+ char ch;
+ unsigned int i;
+ DynamicStrings_String t;
+
+ if (s != NULL)
+ {
+ MarkInvalid (s);
+ t = s;
+ while (t != NULL)
+ {
+ i = 0;
+ while (i < t->contents.len)
+ {
+ ch = t->contents.buf.array[i];
+ if ((ch >= 'A') && (ch <= 'Z'))
+ {
+ t->contents.buf.array[i] = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('A')))+ ((unsigned int) ('a'))));
+ }
+ i += 1;
+ }
+ t = t->contents.next;
+ }
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ CopyOut - copies string, s, to a.
+*/
+
+extern "C" void DynamicStrings_CopyOut (char *a, unsigned int _a_high, DynamicStrings_String s)
+{
+ unsigned int i;
+ unsigned int l;
+
+ l = Min (_a_high+1, DynamicStrings_Length (s));
+ i = 0;
+ while (i < l)
+ {
+ a[i] = DynamicStrings_char (s, static_cast<int> (i));
+ i += 1;
+ }
+ if (i <= _a_high)
+ {
+ a[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ char - returns the character, ch, at position, i, in String, s.
+*/
+
+extern "C" char DynamicStrings_char (DynamicStrings_String s, int i)
+{
+ unsigned int c;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (i < 0)
+ {
+ c = (unsigned int ) (((int ) (DynamicStrings_Length (s)))+i);
+ }
+ else
+ {
+ c = i;
+ }
+ while ((s != NULL) && (c >= s->contents.len))
+ {
+ c -= s->contents.len;
+ s = s->contents.next;
+ }
+ if ((s == NULL) || (c >= s->contents.len))
+ {
+ return ASCII_nul;
+ }
+ else
+ {
+ return s->contents.buf.array[c];
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ string - returns the C style char * of String, s.
+*/
+
+extern "C" void * DynamicStrings_string (DynamicStrings_String s)
+{
+ typedef char *string__T2;
+
+ DynamicStrings_String a;
+ unsigned int l;
+ unsigned int i;
+ string__T2 p;
+
+ if (PoisonOn)
+ {
+ s = CheckPoisoned (s);
+ }
+ if (s == NULL)
+ {
+ return NULL;
+ }
+ else
+ {
+ if (! s->head->charStarValid)
+ {
+ l = DynamicStrings_Length (s);
+ if (! (s->head->charStarUsed && (s->head->charStarSize > l)))
+ {
+ DeallocateCharStar (s);
+ Storage_ALLOCATE (&s->head->charStar, l+1);
+ s->head->charStarSize = l+1;
+ s->head->charStarUsed = TRUE;
+ }
+ p = static_cast<string__T2> (s->head->charStar);
+ a = s;
+ while (a != NULL)
+ {
+ i = 0;
+ while (i < a->contents.len)
+ {
+ (*p) = a->contents.buf.array[i];
+ i += 1;
+ p += 1;
+ }
+ a = a->contents.next;
+ }
+ (*p) = ASCII_nul;
+ s->head->charStarValid = TRUE;
+ }
+ return s->head->charStar;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitStringDB - the debug version of InitString.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringDB (const char *a_, unsigned int _a_high, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char a[_a_high+1];
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_InitString ((const char *) a, _a_high), (const char *) file, _file_high, line, (const char *) "InitString", 10);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitStringCharStarDB - the debug version of InitStringCharStar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharStarDB (void * a, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_InitStringCharStar (a), (const char *) file, _file_high, line, (const char *) "InitStringCharStar", 18);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitStringCharDB - the debug version of InitStringChar.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_InitStringCharDB (char ch, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_InitStringChar (ch), (const char *) file, _file_high, line, (const char *) "InitStringChar", 14);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ MultDB - the debug version of MultDB.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_MultDB (DynamicStrings_String s, unsigned int n, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_Mult (s, n), (const char *) file, _file_high, line, (const char *) "Mult", 4);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DupDB - the debug version of Dup.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_DupDB (DynamicStrings_String s, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ return AssignDebug (DynamicStrings_Dup (s), (const char *) file, _file_high, line, (const char *) "Dup", 3);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SliceDB - debug version of Slice.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_SliceDB (DynamicStrings_String s, int low, int high, const char *file_, unsigned int _file_high, unsigned int line)
+{
+ char file[_file_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+
+ DSdbEnter ();
+ s = AssignDebug (DynamicStrings_Slice (s, low, high), (const char *) file, _file_high, line, (const char *) "Slice", 5);
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PushAllocation - pushes the current allocation/deallocation lists.
+*/
+
+extern "C" void DynamicStrings_PushAllocation (void)
+{
+ DynamicStrings_frame f;
+
+ if (CheckOn)
+ {
+ Init ();
+ Storage_ALLOCATE ((void **) &f, sizeof (DynamicStrings_frameRec));
+ f->next = frameHead;
+ f->alloc = NULL;
+ f->dealloc = NULL;
+ frameHead = f;
+ }
+}
+
+
+/*
+ PopAllocation - test to see that all strings are deallocated since
+ the last push. Then it pops to the previous
+ allocation/deallocation lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" void DynamicStrings_PopAllocation (unsigned int halt)
+{
+ if (CheckOn)
+ {
+ if ((DynamicStrings_PopAllocationExemption (halt, NULL)) == NULL)
+ {} /* empty. */
+ }
+}
+
+
+/*
+ PopAllocationExemption - test to see that all strings are deallocated, except
+ string, e, since the last push.
+ Then it pops to the previous allocation/deallocation
+ lists.
+
+ If halt is true then the application terminates
+ with an exit code of 1.
+*/
+
+extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned int halt, DynamicStrings_String e)
+{
+ DynamicStrings_String s;
+ DynamicStrings_frame f;
+ unsigned int b;
+
+ Init ();
+ if (CheckOn)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (frameHead == NULL)
+ {
+ stop ();
+ /* writeString ("mismatched number of PopAllocation's compared to PushAllocation's") */
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65);
+ }
+ else
+ {
+ if (frameHead->alloc != NULL)
+ {
+ b = FALSE;
+ s = frameHead->alloc;
+ while (s != NULL)
+ {
+ if (! (((e == s) || (IsOnGarbage (e, s))) || (IsOnGarbage (s, e))))
+ {
+ if (! b)
+ {
+ writeString ((const char *) "the following strings have been lost", 36);
+ writeLn ();
+ b = TRUE;
+ }
+ DumpStringInfo (s, 0);
+ }
+ s = s->debug.next;
+ }
+ if (b && halt)
+ {
+ libc_exit (1);
+ }
+ }
+ frameHead = frameHead->next;
+ }
+ }
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_DynamicStrings_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Initialized = FALSE;
+ Init ();
+}
+
+extern "C" void _M2_DynamicStrings_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GEnvironment.cc b/gcc/m2/mc-boot/GEnvironment.cc
new file mode 100644
index 00000000000..aa5e7662873
--- /dev/null
+++ b/gcc/m2/mc-boot/GEnvironment.cc
@@ -0,0 +1,129 @@
+/* do not edit automatically generated by mc from Environment. */
+/* Environment.mod provides access to the environment settings of a process.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _Environment_H
+#define _Environment_C
+
+# include "GSYSTEM.h"
+# include "Glibc.h"
+# include "GASCII.h"
+# include "GStrLib.h"
+
+
+/*
+ GetEnvironment - gets the environment variable Env and places
+ a copy of its value into string, dest.
+ It returns TRUE if the string Env was found in
+ the processes environment.
+*/
+
+extern "C" unsigned int Environment_GetEnvironment (const char *Env_, unsigned int _Env_high, char *dest, unsigned int _dest_high);
+
+/*
+ PutEnvironment - change or add an environment variable definition EnvDef.
+ TRUE is returned if the environment variable was
+ set or changed successfully.
+*/
+
+extern "C" unsigned int Environment_PutEnvironment (const char *EnvDef_, unsigned int _EnvDef_high);
+
+
+/*
+ GetEnvironment - gets the environment variable Env and places
+ a copy of its value into string, dest.
+ It returns TRUE if the string Env was found in
+ the processes environment.
+*/
+
+extern "C" unsigned int Environment_GetEnvironment (const char *Env_, unsigned int _Env_high, char *dest, unsigned int _dest_high)
+{
+ typedef char *GetEnvironment__T1;
+
+ unsigned int High;
+ unsigned int i;
+ GetEnvironment__T1 Addr;
+ char Env[_Env_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (Env, Env_, _Env_high+1);
+
+ i = 0;
+ High = _dest_high;
+ Addr = static_cast<GetEnvironment__T1> (libc_getenv (&Env));
+ while (((i < High) && (Addr != NULL)) && ((*Addr) != ASCII_nul))
+ {
+ dest[i] = (*Addr);
+ Addr += 1;
+ i += 1;
+ }
+ if (i < High)
+ {
+ dest[i] = ASCII_nul;
+ }
+ return Addr != NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PutEnvironment - change or add an environment variable definition EnvDef.
+ TRUE is returned if the environment variable was
+ set or changed successfully.
+*/
+
+extern "C" unsigned int Environment_PutEnvironment (const char *EnvDef_, unsigned int _EnvDef_high)
+{
+ char EnvDef[_EnvDef_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (EnvDef, EnvDef_, _EnvDef_high+1);
+
+ return (libc_putenv (&EnvDef)) == 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_Environment_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Environment_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GFIO.cc b/gcc/m2/mc-boot/GFIO.cc
new file mode 100644
index 00000000000..65819a10a4b
--- /dev/null
+++ b/gcc/m2/mc-boot/GFIO.cc
@@ -0,0 +1,2322 @@
+/* do not edit automatically generated by mc from FIO. */
+/* FIO.mod provides a simple buffered file input/output library.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _FIO_H
+#define _FIO_C
+
+# include "GSYSTEM.h"
+# include "GASCII.h"
+# include "GStrLib.h"
+# include "GStorage.h"
+# include "GNumberIO.h"
+# include "Glibc.h"
+# include "GIndexing.h"
+# include "GM2RTS.h"
+
+typedef unsigned int FIO_File;
+
+FIO_File FIO_StdErr;
+FIO_File FIO_StdOut;
+FIO_File FIO_StdIn;
+# define SEEK_SET 0
+# define SEEK_END 2
+# define UNIXREADONLY 0
+# define UNIXWRITEONLY 1
+# define CreatePermissions 0666
+# define MaxBufferLength (1024*16)
+# define MaxErrorString (1024*8)
+typedef struct FIO_NameInfo_r FIO_NameInfo;
+
+typedef struct FIO_buf_r FIO_buf;
+
+typedef FIO_buf *FIO_Buffer;
+
+typedef struct FIO_fds_r FIO_fds;
+
+typedef FIO_fds *FIO_FileDescriptor;
+
+typedef struct FIO__T7_a FIO__T7;
+
+typedef char *FIO_PtrToChar;
+
+typedef enum {FIO_successful, FIO_outofmemory, FIO_toomanyfilesopen, FIO_failed, FIO_connectionfailure, FIO_endofline, FIO_endoffile} FIO_FileStatus;
+
+typedef enum {FIO_unused, FIO_openedforread, FIO_openedforwrite, FIO_openedforrandom} FIO_FileUsage;
+
+struct FIO_NameInfo_r {
+ void *address;
+ unsigned int size;
+ };
+
+struct FIO_buf_r {
+ unsigned int valid;
+ long int bufstart;
+ unsigned int position;
+ void *address;
+ unsigned int filled;
+ unsigned int size;
+ unsigned int left;
+ FIO__T7 *contents;
+ };
+
+struct FIO__T7_a { char array[MaxBufferLength+1]; };
+struct FIO_fds_r {
+ int unixfd;
+ FIO_NameInfo name;
+ FIO_FileStatus state;
+ FIO_FileUsage usage;
+ unsigned int output;
+ FIO_Buffer buffer;
+ long int abspos;
+ };
+
+static Indexing_Index FileInfo;
+static FIO_File Error;
+
+/*
+ IsNoError - returns a TRUE if no error has occured on file, f.
+*/
+
+extern "C" unsigned int FIO_IsNoError (FIO_File f);
+
+/*
+ IsActive - returns TRUE if the file, f, is still active.
+*/
+
+extern "C" unsigned int FIO_IsActive (FIO_File f);
+extern "C" unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high);
+extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high);
+extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high);
+extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, unsigned int towrite, unsigned int newfile);
+
+/*
+ Close - close a file which has been previously opened using:
+ OpenToRead, OpenToWrite, OpenForRandom.
+ It is correct to close a file which has an error status.
+*/
+
+extern "C" void FIO_Close (FIO_File f);
+
+/*
+ exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+extern "C" unsigned int FIO_exists (void * fname, unsigned int flength);
+
+/*
+ openToRead - attempts to open a file, fname, for reading and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength);
+
+/*
+ openToWrite - attempts to open a file, fname, for write and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength);
+
+/*
+ openForRandom - attempts to open a file, fname, for random access
+ read or write and it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+ towrite, determines whether the file should be
+ opened for writing or reading.
+*/
+
+extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile);
+
+/*
+ FlushBuffer - flush contents of file, f.
+*/
+
+extern "C" void FIO_FlushBuffer (FIO_File f);
+
+/*
+ ReadNBytes - reads nBytes of a file into memory area, dest, returning
+ the number of bytes actually read.
+ This function will consume from the buffer and then
+ perform direct libc reads. It is ideal for large reads.
+*/
+
+extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest);
+
+/*
+ ReadAny - reads HIGH(a) bytes into, a. All input
+ is fully buffered, unlike ReadNBytes and thus is more
+ suited to small reads.
+*/
+
+extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high);
+
+/*
+ WriteNBytes - writes nBytes from memory area src to a file
+ returning the number of bytes actually written.
+ This function will flush the buffer and then
+ write the nBytes using a direct write from libc.
+ It is ideal for large writes.
+*/
+
+extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src);
+
+/*
+ WriteAny - writes HIGH(a) bytes onto, file, f. All output
+ is fully buffered, unlike WriteNBytes and thus is more
+ suited to small writes.
+*/
+
+extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high);
+
+/*
+ WriteChar - writes a single character to file, f.
+*/
+
+extern "C" void FIO_WriteChar (FIO_File f, char ch);
+
+/*
+ EOF - tests to see whether a file, f, has reached end of file.
+*/
+
+extern "C" unsigned int FIO_EOF (FIO_File f);
+
+/*
+ EOLN - tests to see whether a file, f, is upon a newline.
+ It does NOT consume the newline.
+*/
+
+extern "C" unsigned int FIO_EOLN (FIO_File f);
+
+/*
+ WasEOLN - tests to see whether a file, f, has just seen a newline.
+*/
+
+extern "C" unsigned int FIO_WasEOLN (FIO_File f);
+
+/*
+ ReadChar - returns a character read from file f.
+ Sensible to check with IsNoError or EOF after calling
+ this function.
+*/
+
+extern "C" char FIO_ReadChar (FIO_File f);
+
+/*
+ UnReadChar - replaces a character, ch, back into file f.
+ This character must have been read by ReadChar
+ and it does not allow successive calls. It may
+ only be called if the previous read was successful
+ or end of file was seen.
+ If the state was previously endoffile then it
+ is altered to successful.
+ Otherwise it is left alone.
+*/
+
+extern "C" void FIO_UnReadChar (FIO_File f, char ch);
+
+/*
+ WriteLine - writes out a linefeed to file, f.
+*/
+
+extern "C" void FIO_WriteLine (FIO_File f);
+
+/*
+ WriteString - writes a string to file, f.
+*/
+
+extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high);
+
+/*
+ ReadString - reads a string from file, f, into string, a.
+ It terminates the string if HIGH is reached or
+ if a newline is seen or an error occurs.
+*/
+
+extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high);
+
+/*
+ WriteCardinal - writes a CARDINAL to file, f.
+ It writes the binary image of the cardinal
+ to file, f.
+*/
+
+extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c);
+
+/*
+ ReadCardinal - reads a CARDINAL from file, f.
+ It reads a binary image of a CARDINAL
+ from a file, f.
+*/
+
+extern "C" unsigned int FIO_ReadCardinal (FIO_File f);
+
+/*
+ GetUnixFileDescriptor - returns the UNIX file descriptor of a file.
+*/
+
+extern "C" int FIO_GetUnixFileDescriptor (FIO_File f);
+
+/*
+ SetPositionFromBeginning - sets the position from the beginning of the file.
+*/
+
+extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos);
+
+/*
+ SetPositionFromEnd - sets the position from the end of the file.
+*/
+
+extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos);
+
+/*
+ FindPosition - returns the current absolute position in file, f.
+*/
+
+extern "C" long int FIO_FindPosition (FIO_File f);
+
+/*
+ GetFileName - assigns, a, with the filename associated with, f.
+*/
+
+extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high);
+
+/*
+ getFileName - returns the address of the filename associated with, f.
+*/
+
+extern "C" void * FIO_getFileName (FIO_File f);
+
+/*
+ getFileNameLength - returns the number of characters associated with filename, f.
+*/
+
+extern "C" unsigned int FIO_getFileNameLength (FIO_File f);
+
+/*
+ FlushOutErr - flushes, StdOut, and, StdErr.
+ It is also called when the application calls M2RTS.Terminate.
+ (which is automatically placed in program modules by the GM2
+ scaffold).
+*/
+
+extern "C" void FIO_FlushOutErr (void);
+
+/*
+ Max - returns the maximum of two values.
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b);
+
+/*
+ Min - returns the minimum of two values.
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b);
+
+/*
+ GetNextFreeDescriptor - returns the index to the FileInfo array indicating
+ the next free slot.
+*/
+
+static FIO_File GetNextFreeDescriptor (void);
+
+/*
+ SetState - sets the field, state, of file, f, to, s.
+*/
+
+static void SetState (FIO_File f, FIO_FileStatus s);
+
+/*
+ InitializeFile - initialize a file descriptor
+*/
+
+static FIO_File InitializeFile (FIO_File f, void * fname, unsigned int flength, FIO_FileStatus fstate, FIO_FileUsage use, unsigned int towrite, unsigned int buflength);
+
+/*
+ ConnectToUnix - connects a FIO file to a UNIX file descriptor.
+*/
+
+static void ConnectToUnix (FIO_File f, unsigned int towrite, unsigned int newfile);
+
+/*
+ ReadFromBuffer - attempts to read, nBytes, from file, f.
+ It firstly consumes the buffer and then performs
+ direct unbuffered reads. This should only be used
+ when wishing to read large files.
+
+ The actual number of bytes read is returned.
+ -1 is returned if EOF is reached.
+*/
+
+static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes);
+
+/*
+ BufferedRead - will read, nBytes, through the buffer.
+ Similar to ReadFromBuffer, but this function will always
+ read into the buffer before copying into memory.
+
+ Useful when performing small reads.
+*/
+
+static int BufferedRead (FIO_File f, unsigned int nBytes, void * a);
+
+/*
+ HandleEscape - translates
+ and \t into their respective ascii codes.
+*/
+
+static void HandleEscape (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, unsigned int *i, unsigned int *j, unsigned int HighSrc, unsigned int HighDest);
+
+/*
+ Cast - casts a := b
+*/
+
+static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high);
+
+/*
+ StringFormat1 - converts string, src, into, dest, together with encapsulated
+ entity, w. It only formats the first %s or %d with n.
+*/
+
+static void StringFormat1 (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ FormatError - provides a orthoganal counterpart to the procedure below.
+*/
+
+static void FormatError (const char *a_, unsigned int _a_high);
+
+/*
+ FormatError1 - generic error procedure taking standard format string
+ and single parameter.
+*/
+
+static void FormatError1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ FormatError2 - generic error procedure taking standard format string
+ and two parameters.
+*/
+
+static void FormatError2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+
+/*
+ CheckAccess - checks to see whether a file f has been
+ opened for read/write.
+*/
+
+static void CheckAccess (FIO_File f, FIO_FileUsage use, unsigned int towrite);
+
+/*
+ SetEndOfLine -
+*/
+
+static void SetEndOfLine (FIO_File f, char ch);
+
+/*
+ BufferedWrite - will write, nBytes, through the buffer.
+ Similar to WriteNBytes, but this function will always
+ write into the buffer before copying into memory.
+
+ Useful when performing small writes.
+*/
+
+static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a);
+
+/*
+ PreInitialize - preinitialize the file descriptor.
+*/
+
+static void PreInitialize (FIO_File f, const char *fname_, unsigned int _fname_high, FIO_FileStatus state, FIO_FileUsage use, unsigned int towrite, int osfd, unsigned int bufsize);
+
+/*
+ Init - initialize the modules, global variables.
+*/
+
+static void Init (void);
+
+
+/*
+ Max - returns the maximum of two values.
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Min - returns the minimum of two values.
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetNextFreeDescriptor - returns the index to the FileInfo array indicating
+ the next free slot.
+*/
+
+static FIO_File GetNextFreeDescriptor (void)
+{
+ FIO_File f;
+ FIO_File h;
+ FIO_FileDescriptor fd;
+
+ f = Error+1;
+ h = Indexing_HighIndice (FileInfo);
+ for (;;)
+ {
+ if (f <= h)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ return f;
+ }
+ }
+ f += 1;
+ if (f > h)
+ {
+ Indexing_PutIndice (FileInfo, f, NULL); /* create new slot */
+ return f; /* create new slot */
+ }
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetState - sets the field, state, of file, f, to, s.
+*/
+
+static void SetState (FIO_File f, FIO_FileStatus s)
+{
+ FIO_FileDescriptor fd;
+
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ fd->state = s;
+}
+
+
+/*
+ InitializeFile - initialize a file descriptor
+*/
+
+static FIO_File InitializeFile (FIO_File f, void * fname, unsigned int flength, FIO_FileStatus fstate, FIO_FileUsage use, unsigned int towrite, unsigned int buflength)
+{
+ FIO_PtrToChar p;
+ FIO_FileDescriptor fd;
+
+ Storage_ALLOCATE ((void **) &fd, sizeof (FIO_fds));
+ if (fd == NULL)
+ {
+ SetState (Error, FIO_outofmemory);
+ return Error;
+ }
+ else
+ {
+ Indexing_PutIndice (FileInfo, f, reinterpret_cast<void *> (fd));
+ fd->name.size = flength+1; /* need to guarantee the nul for C */
+ fd->usage = use; /* need to guarantee the nul for C */
+ fd->output = towrite;
+ Storage_ALLOCATE (&fd->name.address, fd->name.size);
+ if (fd->name.address == NULL)
+ {
+ fd->state = FIO_outofmemory;
+ return f;
+ }
+ fd->name.address = libc_strncpy (fd->name.address, fname, flength);
+ /* and assign nul to the last byte */
+ p = static_cast<FIO_PtrToChar> (fd->name.address);
+ p += flength;
+ (*p) = ASCII_nul;
+ fd->abspos = 0;
+ /* now for the buffer */
+ Storage_ALLOCATE ((void **) &fd->buffer, sizeof (FIO_buf));
+ if (fd->buffer == NULL)
+ {
+ SetState (Error, FIO_outofmemory);
+ return Error;
+ }
+ else
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->bufstart = 0;
+ fd->buffer->size = buflength;
+ fd->buffer->position = 0;
+ fd->buffer->filled = 0;
+ if (fd->buffer->size == 0)
+ {
+ fd->buffer->address = NULL;
+ }
+ else
+ {
+ Storage_ALLOCATE (&fd->buffer->address, fd->buffer->size);
+ if (fd->buffer->address == NULL)
+ {
+ fd->state = FIO_outofmemory;
+ return f;
+ }
+ }
+ if (towrite)
+ {
+ fd->buffer->left = fd->buffer->size;
+ }
+ else
+ {
+ fd->buffer->left = 0;
+ }
+ fd->buffer->contents = reinterpret_cast<FIO__T7 *> (fd->buffer->address); /* provides easy access for reading characters */
+ fd->state = fstate; /* provides easy access for reading characters */
+ }
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ConnectToUnix - connects a FIO file to a UNIX file descriptor.
+*/
+
+static void ConnectToUnix (FIO_File f, unsigned int towrite, unsigned int newfile)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ if (towrite)
+ {
+ if (newfile)
+ {
+ fd->unixfd = libc_creat (fd->name.address, CreatePermissions);
+ }
+ else
+ {
+ fd->unixfd = libc_open (fd->name.address, UNIXWRITEONLY, 0);
+ }
+ }
+ else
+ {
+ fd->unixfd = libc_open (fd->name.address, UNIXREADONLY, 0);
+ }
+ if (fd->unixfd < 0)
+ {
+ fd->state = FIO_connectionfailure;
+ }
+ }
+ }
+}
+
+
+/*
+ ReadFromBuffer - attempts to read, nBytes, from file, f.
+ It firstly consumes the buffer and then performs
+ direct unbuffered reads. This should only be used
+ when wishing to read large files.
+
+ The actual number of bytes read is returned.
+ -1 is returned if EOF is reached.
+*/
+
+static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes)
+{
+ typedef unsigned char *ReadFromBuffer__T1;
+
+ void * t;
+ int result;
+ unsigned int total;
+ unsigned int n;
+ ReadFromBuffer__T1 p;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ total = 0; /* how many bytes have we read */
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f)); /* how many bytes have we read */
+ /* extract from the buffer first */
+ if ((fd->buffer != NULL) && fd->buffer->valid)
+ {
+ if (fd->buffer->left > 0)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (nBytes == 1)
+ {
+ /* too expensive to call memcpy for 1 character */
+ p = static_cast<ReadFromBuffer__T1> (a);
+ (*p) = static_cast<unsigned char> ((*fd->buffer->contents).array[fd->buffer->position]);
+ fd->buffer->left -= 1; /* remove consumed bytes */
+ fd->buffer->position += 1; /* move onwards n bytes */
+ nBytes = 0;
+ /* read */
+ return 1;
+ }
+ else
+ {
+ n = Min (fd->buffer->left, nBytes);
+ t = fd->buffer->address;
+ t = reinterpret_cast<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
+ p = static_cast<ReadFromBuffer__T1> (libc_memcpy (a, t, static_cast<size_t> (n)));
+ fd->buffer->left -= n; /* remove consumed bytes */
+ fd->buffer->position += n; /* move onwards n bytes */
+ /* move onwards ready for direct reads */
+ a = reinterpret_cast<void *> (reinterpret_cast<char *> (a)+n);
+ nBytes -= n; /* reduce the amount for future direct */
+ /* read */
+ total += n;
+ return total; /* much cleaner to return now, */
+ }
+ /* difficult to record an error if */
+ }
+ /* the read below returns -1 */
+ }
+ if (nBytes > 0)
+ {
+ /* still more to read */
+ result = static_cast<int> (libc_read (fd->unixfd, a, static_cast<size_t> ((int ) (nBytes))));
+ if (result > 0)
+ {
+ /* avoid dangling else. */
+ total += result;
+ fd->abspos += result;
+ /* now disable the buffer as we read directly into, a. */
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->valid = FALSE;
+ }
+ }
+ else
+ {
+ if (result == 0)
+ {
+ /* eof reached */
+ fd->state = FIO_endoffile;
+ }
+ else
+ {
+ fd->state = FIO_failed;
+ }
+ /* indicate buffer is empty */
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->left = 0;
+ fd->buffer->position = 0;
+ if (fd->buffer->address != NULL)
+ {
+ (*fd->buffer->contents).array[fd->buffer->position] = ASCII_nul;
+ }
+ }
+ return -1;
+ }
+ }
+ return total;
+ }
+ else
+ {
+ return -1;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ BufferedRead - will read, nBytes, through the buffer.
+ Similar to ReadFromBuffer, but this function will always
+ read into the buffer before copying into memory.
+
+ Useful when performing small reads.
+*/
+
+static int BufferedRead (FIO_File f, unsigned int nBytes, void * a)
+{
+ typedef unsigned char *BufferedRead__T3;
+
+ void * t;
+ int result;
+ int total;
+ int n;
+ BufferedRead__T3 p;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ total = 0; /* how many bytes have we read */
+ if (fd != NULL) /* how many bytes have we read */
+ {
+ /* extract from the buffer first */
+ if (fd->buffer != NULL)
+ {
+ while (nBytes > 0)
+ {
+ if ((fd->buffer->left > 0) && fd->buffer->valid)
+ {
+ if (nBytes == 1)
+ {
+ /* too expensive to call memcpy for 1 character */
+ p = static_cast<BufferedRead__T3> (a);
+ (*p) = static_cast<unsigned char> ((*fd->buffer->contents).array[fd->buffer->position]);
+ fd->buffer->left -= 1; /* remove consumed byte */
+ fd->buffer->position += 1; /* move onwards n byte */
+ total += 1; /* move onwards n byte */
+ return total;
+ }
+ else
+ {
+ n = Min (fd->buffer->left, nBytes);
+ t = fd->buffer->address;
+ t = reinterpret_cast<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
+ p = static_cast<BufferedRead__T3> (libc_memcpy (a, t, static_cast<size_t> (n)));
+ fd->buffer->left -= n; /* remove consumed bytes */
+ fd->buffer->position += n; /* move onwards n bytes */
+ /* move onwards ready for direct reads */
+ a = reinterpret_cast<void *> (reinterpret_cast<char *> (a)+n);
+ nBytes -= n; /* reduce the amount for future direct */
+ /* read */
+ total += n;
+ }
+ }
+ else
+ {
+ /* refill buffer */
+ n = static_cast<int> (libc_read (fd->unixfd, fd->buffer->address, static_cast<size_t> (fd->buffer->size)));
+ if (n >= 0)
+ {
+ /* avoid dangling else. */
+ fd->buffer->valid = TRUE;
+ fd->buffer->position = 0;
+ fd->buffer->left = n;
+ fd->buffer->filled = n;
+ fd->buffer->bufstart = fd->abspos;
+ fd->abspos += n;
+ if (n == 0)
+ {
+ /* eof reached */
+ fd->state = FIO_endoffile;
+ return -1;
+ }
+ }
+ else
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->position = 0;
+ fd->buffer->left = 0;
+ fd->buffer->filled = 0;
+ fd->state = FIO_failed;
+ return total;
+ }
+ }
+ }
+ return total;
+ }
+ }
+ }
+ return -1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ HandleEscape - translates
+ and \t into their respective ascii codes.
+*/
+
+static void HandleEscape (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, unsigned int *i, unsigned int *j, unsigned int HighSrc, unsigned int HighDest)
+{
+ char src[_src_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (src, src_, _src_high+1);
+
+ if (((((*i)+1) < HighSrc) && (src[(*i)] == '\\')) && ((*j) < HighDest))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (src[(*i)+1] == 'n')
+ {
+ /* requires a newline */
+ dest[(*j)] = ASCII_nl;
+ (*j) += 1;
+ (*i) += 2;
+ }
+ else if (src[(*i)+1] == 't')
+ {
+ /* avoid dangling else. */
+ /* requires a tab (yuck) tempted to fake this but I better not.. */
+ dest[(*j)] = ASCII_tab;
+ (*j) += 1;
+ (*i) += 2;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ /* copy escaped character */
+ (*i) += 1;
+ dest[(*j)] = src[(*i)];
+ (*j) += 1;
+ (*i) += 1;
+ }
+ }
+}
+
+
+/*
+ Cast - casts a := b
+*/
+
+static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (b, b_, _b_high+1);
+
+ if (_a_high == _b_high)
+ {
+ for (i=0; i<=_a_high; i++)
+ {
+ a[i] = b[i];
+ }
+ }
+ else
+ {
+ FormatError ((const char *) "cast failed", 11);
+ }
+}
+
+
+/*
+ StringFormat1 - converts string, src, into, dest, together with encapsulated
+ entity, w. It only formats the first %s or %d with n.
+*/
+
+static void StringFormat1 (char *dest, unsigned int _dest_high, const char *src_, unsigned int _src_high, const unsigned char *w_, unsigned int _w_high)
+{
+ typedef struct StringFormat1__T8_a StringFormat1__T8;
+
+ typedef char *StringFormat1__T4;
+
+ struct StringFormat1__T8_a { char array[MaxErrorString+1]; };
+ unsigned int HighSrc;
+ unsigned int HighDest;
+ unsigned int c;
+ unsigned int i;
+ unsigned int j;
+ StringFormat1__T8 str;
+ StringFormat1__T4 p;
+ char src[_src_high+1];
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (src, src_, _src_high+1);
+ memcpy (w, w_, _w_high+1);
+
+ HighSrc = StrLib_StrLen ((const char *) src, _src_high);
+ HighDest = _dest_high;
+ p = NULL;
+ c = 0;
+ i = 0;
+ j = 0;
+ while ((((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest)) && (src[i] != '%'))
+ {
+ if (src[i] == '\\')
+ {
+ HandleEscape ((char *) dest, _dest_high, (const char *) src, _src_high, &i, &j, HighSrc, HighDest);
+ }
+ else
+ {
+ dest[j] = src[i];
+ i += 1;
+ j += 1;
+ }
+ }
+ if ((((i+1) < HighSrc) && (src[i] == '%')) && (j < HighDest))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (src[i+1] == 's')
+ {
+ Cast ((unsigned char *) &p, (sizeof (p)-1), (const unsigned char *) w, _w_high);
+ while ((j < HighDest) && ((*p) != ASCII_nul))
+ {
+ dest[j] = (*p);
+ j += 1;
+ p += 1;
+ }
+ if (j < HighDest)
+ {
+ dest[j] = ASCII_nul;
+ }
+ j = StrLib_StrLen ((const char *) dest, _dest_high);
+ i += 2;
+ }
+ else if (src[i+1] == 'd')
+ {
+ /* avoid dangling else. */
+ dest[j] = ASCII_nul;
+ Cast ((unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) w, _w_high);
+ NumberIO_CardToStr (c, 0, (char *) &str.array[0], MaxErrorString);
+ StrLib_StrConCat ((const char *) dest, _dest_high, (const char *) &str.array[0], MaxErrorString, (char *) dest, _dest_high);
+ j = StrLib_StrLen ((const char *) dest, _dest_high);
+ i += 2;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ dest[j] = src[i];
+ i += 1;
+ j += 1;
+ }
+ }
+ /* and finish off copying src into dest */
+ while (((i < HighSrc) && (src[i] != ASCII_nul)) && (j < HighDest))
+ {
+ if (src[i] == '\\')
+ {
+ HandleEscape ((char *) dest, _dest_high, (const char *) src, _src_high, &i, &j, HighSrc, HighDest);
+ }
+ else
+ {
+ dest[j] = src[i];
+ i += 1;
+ j += 1;
+ }
+ }
+ if (j < HighDest)
+ {
+ dest[j] = ASCII_nul;
+ }
+}
+
+
+/*
+ FormatError - provides a orthoganal counterpart to the procedure below.
+*/
+
+static void FormatError (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ FIO_WriteString (FIO_StdErr, (const char *) a, _a_high);
+}
+
+
+/*
+ FormatError1 - generic error procedure taking standard format string
+ and single parameter.
+*/
+
+static void FormatError1 (const char *a_, unsigned int _a_high, const unsigned char *w_, unsigned int _w_high)
+{
+ typedef struct FormatError1__T9_a FormatError1__T9;
+
+ struct FormatError1__T9_a { char array[MaxErrorString+1]; };
+ FormatError1__T9 s;
+ char a[_a_high+1];
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w, w_, _w_high+1);
+
+ StringFormat1 ((char *) &s.array[0], MaxErrorString, (const char *) a, _a_high, (const unsigned char *) w, _w_high);
+ FormatError ((const char *) &s.array[0], MaxErrorString);
+}
+
+
+/*
+ FormatError2 - generic error procedure taking standard format string
+ and two parameters.
+*/
+
+static void FormatError2 (const char *a_, unsigned int _a_high, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high)
+{
+ typedef struct FormatError2__T10_a FormatError2__T10;
+
+ struct FormatError2__T10_a { char array[MaxErrorString+1]; };
+ FormatError2__T10 s;
+ char a[_a_high+1];
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+
+ StringFormat1 ((char *) &s.array[0], MaxErrorString, (const char *) a, _a_high, (const unsigned char *) w1, _w1_high);
+ FormatError1 ((const char *) &s.array[0], MaxErrorString, (const unsigned char *) w2, _w2_high);
+}
+
+
+/*
+ CheckAccess - checks to see whether a file f has been
+ opened for read/write.
+*/
+
+static void CheckAccess (FIO_File f, FIO_FileUsage use, unsigned int towrite)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ /* avoid dangling else. */
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ if (f != FIO_StdErr)
+ {
+ FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96);
+ }
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ if ((use == FIO_openedforwrite) && (fd->usage == FIO_openedforread))
+ {
+ FormatError1 ((const char *) "this file (%s) has been opened for reading but is now being written\\n", 69, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else if ((use == FIO_openedforread) && (fd->usage == FIO_openedforwrite))
+ {
+ /* avoid dangling else. */
+ FormatError1 ((const char *) "this file (%s) has been opened for writing but is now being read\\n", 66, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else if (fd->state == FIO_connectionfailure)
+ {
+ /* avoid dangling else. */
+ FormatError1 ((const char *) "this file (%s) was not successfully opened\\n", 44, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else if (towrite != fd->output)
+ {
+ /* avoid dangling else. */
+ if (fd->output)
+ {
+ FormatError1 ((const char *) "this file (%s) was opened for writing but is now being read\\n", 61, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ FormatError1 ((const char *) "this file (%s) was opened for reading but is now being written\\n", 64, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ }
+ }
+ }
+ else
+ {
+ FormatError ((const char *) "this file has not been opened successfully\\n", 44);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ SetEndOfLine -
+*/
+
+static void SetEndOfLine (FIO_File f, char ch)
+{
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (ch == ASCII_nl)
+ {
+ fd->state = FIO_endofline;
+ }
+ else
+ {
+ fd->state = FIO_successful;
+ }
+ }
+}
+
+
+/*
+ BufferedWrite - will write, nBytes, through the buffer.
+ Similar to WriteNBytes, but this function will always
+ write into the buffer before copying into memory.
+
+ Useful when performing small writes.
+*/
+
+static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a)
+{
+ typedef unsigned char *BufferedWrite__T5;
+
+ void * t;
+ int result;
+ int total;
+ int n;
+ BufferedWrite__T5 p;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ total = 0; /* how many bytes have we read */
+ if (fd->buffer != NULL) /* how many bytes have we read */
+ {
+ /* place into the buffer first */
+ while (nBytes > 0)
+ {
+ if (fd->buffer->left > 0)
+ {
+ if (nBytes == 1)
+ {
+ /* too expensive to call memcpy for 1 character */
+ p = static_cast<BufferedWrite__T5> (a);
+ (*fd->buffer->contents).array[fd->buffer->position] = static_cast<char> ((*p));
+ fd->buffer->left -= 1; /* reduce space */
+ fd->buffer->position += 1; /* move onwards n byte */
+ total += 1; /* move onwards n byte */
+ return total;
+ }
+ else
+ {
+ n = Min (fd->buffer->left, nBytes);
+ t = fd->buffer->address;
+ t = reinterpret_cast<void *> (reinterpret_cast<char *> (t)+fd->buffer->position);
+ p = static_cast<BufferedWrite__T5> (libc_memcpy (a, t, static_cast<size_t> ((unsigned int ) (n))));
+ fd->buffer->left -= n; /* remove consumed bytes */
+ fd->buffer->position += n; /* move onwards n bytes */
+ /* move ready for further writes */
+ a = reinterpret_cast<void *> (reinterpret_cast<char *> (a)+n);
+ nBytes -= n; /* reduce the amount for future writes */
+ total += n; /* reduce the amount for future writes */
+ }
+ }
+ else
+ {
+ FIO_FlushBuffer (f);
+ if ((fd->state != FIO_successful) && (fd->state != FIO_endofline))
+ {
+ nBytes = 0;
+ }
+ }
+ }
+ return total;
+ }
+ }
+ }
+ return -1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PreInitialize - preinitialize the file descriptor.
+*/
+
+static void PreInitialize (FIO_File f, const char *fname_, unsigned int _fname_high, FIO_FileStatus state, FIO_FileUsage use, unsigned int towrite, int osfd, unsigned int bufsize)
+{
+ FIO_FileDescriptor fd;
+ FIO_FileDescriptor fe;
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ if ((InitializeFile (f, &fname, StrLib_StrLen ((const char *) fname, _fname_high), state, use, towrite, bufsize)) == f)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (f == Error)
+ {
+ fe = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, FIO_StdErr));
+ if (fe == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ fd->unixfd = fe->unixfd; /* the error channel */
+ }
+ }
+ else
+ {
+ fd->unixfd = osfd;
+ }
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ Init - initialize the modules, global variables.
+*/
+
+static void Init (void)
+{
+ FileInfo = Indexing_InitIndex (0);
+ Error = 0;
+ PreInitialize (Error, (const char *) "error", 5, FIO_toomanyfilesopen, FIO_unused, FALSE, -1, 0);
+ FIO_StdIn = 1;
+ PreInitialize (FIO_StdIn, (const char *) "<stdin>", 7, FIO_successful, FIO_openedforread, FALSE, 0, MaxBufferLength);
+ FIO_StdOut = 2;
+ PreInitialize (FIO_StdOut, (const char *) "<stdout>", 8, FIO_successful, FIO_openedforwrite, TRUE, 1, MaxBufferLength);
+ FIO_StdErr = 3;
+ PreInitialize (FIO_StdErr, (const char *) "<stderr>", 8, FIO_successful, FIO_openedforwrite, TRUE, 2, MaxBufferLength);
+ if (! (M2RTS_InstallTerminationProcedure ((PROC ) {(PROC_t) FIO_FlushOutErr})))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ IsNoError - returns a TRUE if no error has occured on file, f.
+*/
+
+extern "C" unsigned int FIO_IsNoError (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f == Error)
+ {
+ return FALSE;
+ }
+ else
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ return (fd != NULL) && (((fd->state == FIO_successful) || (fd->state == FIO_endoffile)) || (fd->state == FIO_endofline));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsActive - returns TRUE if the file, f, is still active.
+*/
+
+extern "C" unsigned int FIO_IsActive (FIO_File f)
+{
+ if (f == Error)
+ {
+ return FALSE;
+ }
+ else
+ {
+ return (Indexing_GetIndice (FileInfo, f)) != NULL;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" unsigned int FIO_Exists (const char *fname_, unsigned int _fname_high)
+{
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ /*
+ The following functions are wrappers for the above.
+ */
+ return FIO_exists (&fname, StrLib_StrLen ((const char *) fname, _fname_high));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" FIO_File FIO_OpenToRead (const char *fname_, unsigned int _fname_high)
+{
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ return FIO_openToRead (&fname, StrLib_StrLen ((const char *) fname, _fname_high));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" FIO_File FIO_OpenToWrite (const char *fname_, unsigned int _fname_high)
+{
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ return FIO_openToWrite (&fname, StrLib_StrLen ((const char *) fname, _fname_high));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" FIO_File FIO_OpenForRandom (const char *fname_, unsigned int _fname_high, unsigned int towrite, unsigned int newfile)
+{
+ char fname[_fname_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (fname, fname_, _fname_high+1);
+
+ return FIO_openForRandom (&fname, StrLib_StrLen ((const char *) fname, _fname_high), towrite, newfile);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Close - close a file which has been previously opened using:
+ OpenToRead, OpenToWrite, OpenForRandom.
+ It is correct to close a file which has an error status.
+*/
+
+extern "C" void FIO_Close (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ /*
+ we allow users to close files which have an error status
+ */
+ if (fd != NULL)
+ {
+ FIO_FlushBuffer (f);
+ if (fd->unixfd >= 0)
+ {
+ if ((libc_close (fd->unixfd)) != 0)
+ {
+ FormatError1 ((const char *) "failed to close file (%s)\\n", 27, (const unsigned char *) &fd->name.address, (sizeof (fd->name.address)-1));
+ fd->state = FIO_failed; /* --fixme-- too late to notify user (unless we return a BOOLEAN) */
+ }
+ }
+ if (fd->name.address != NULL)
+ {
+ Storage_DEALLOCATE (&fd->name.address, fd->name.size);
+ }
+ if (fd->buffer != NULL)
+ {
+ if (fd->buffer->address != NULL)
+ {
+ Storage_DEALLOCATE (&fd->buffer->address, fd->buffer->size);
+ }
+ Storage_DEALLOCATE ((void **) &fd->buffer, sizeof (FIO_buf));
+ fd->buffer = NULL;
+ }
+ Storage_DEALLOCATE ((void **) &fd, sizeof (FIO_fds));
+ Indexing_PutIndice (FileInfo, f, NULL);
+ }
+ }
+}
+
+
+/*
+ exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+extern "C" unsigned int FIO_exists (void * fname, unsigned int flength)
+{
+ FIO_File f;
+
+ f = FIO_openToRead (fname, flength);
+ if (FIO_IsNoError (f))
+ {
+ FIO_Close (f);
+ return TRUE;
+ }
+ else
+ {
+ FIO_Close (f);
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ openToRead - attempts to open a file, fname, for reading and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File FIO_openToRead (void * fname, unsigned int flength)
+{
+ FIO_File f;
+
+ f = GetNextFreeDescriptor ();
+ if (f == Error)
+ {
+ SetState (f, FIO_toomanyfilesopen);
+ }
+ else
+ {
+ f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforread, FALSE, MaxBufferLength);
+ ConnectToUnix (f, FALSE, FALSE);
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ openToWrite - attempts to open a file, fname, for write and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File FIO_openToWrite (void * fname, unsigned int flength)
+{
+ FIO_File f;
+
+ f = GetNextFreeDescriptor ();
+ if (f == Error)
+ {
+ SetState (f, FIO_toomanyfilesopen);
+ }
+ else
+ {
+ f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforwrite, TRUE, MaxBufferLength);
+ ConnectToUnix (f, TRUE, TRUE);
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ openForRandom - attempts to open a file, fname, for random access
+ read or write and it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+ towrite, determines whether the file should be
+ opened for writing or reading.
+*/
+
+extern "C" FIO_File FIO_openForRandom (void * fname, unsigned int flength, unsigned int towrite, unsigned int newfile)
+{
+ FIO_File f;
+
+ f = GetNextFreeDescriptor ();
+ if (f == Error)
+ {
+ SetState (f, FIO_toomanyfilesopen);
+ }
+ else
+ {
+ f = InitializeFile (f, fname, flength, FIO_successful, FIO_openedforrandom, towrite, MaxBufferLength);
+ ConnectToUnix (f, towrite, newfile);
+ }
+ return f;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FlushBuffer - flush contents of file, f.
+*/
+
+extern "C" void FIO_FlushBuffer (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ if (fd->output && (fd->buffer != NULL))
+ {
+ if ((fd->buffer->position == 0) || ((libc_write (fd->unixfd, fd->buffer->address, static_cast<size_t> (fd->buffer->position))) == ((int ) (fd->buffer->position))))
+ {
+ fd->abspos += fd->buffer->position;
+ fd->buffer->bufstart = fd->abspos;
+ fd->buffer->position = 0;
+ fd->buffer->filled = 0;
+ fd->buffer->left = fd->buffer->size;
+ }
+ else
+ {
+ fd->state = FIO_failed;
+ }
+ }
+ }
+ }
+}
+
+
+/*
+ ReadNBytes - reads nBytes of a file into memory area, dest, returning
+ the number of bytes actually read.
+ This function will consume from the buffer and then
+ perform direct libc reads. It is ideal for large reads.
+*/
+
+extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest)
+{
+ typedef char *ReadNBytes__T2;
+
+ int n;
+ ReadNBytes__T2 p;
+
+ if (f != Error)
+ {
+ CheckAccess (f, FIO_openedforread, FALSE);
+ n = ReadFromBuffer (f, dest, nBytes);
+ if (n <= 0)
+ {
+ return 0;
+ }
+ else
+ {
+ p = static_cast<ReadNBytes__T2> (dest);
+ p += n-1;
+ SetEndOfLine (f, (*p));
+ return n;
+ }
+ }
+ else
+ {
+ return 0;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ReadAny - reads HIGH(a) bytes into, a. All input
+ is fully buffered, unlike ReadNBytes and thus is more
+ suited to small reads.
+*/
+
+extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high)
+{
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if ((BufferedRead (f, _a_high, a)) == ((int ) (_a_high)))
+ {
+ SetEndOfLine (f, static_cast<char> (a[_a_high]));
+ }
+}
+
+
+/*
+ WriteNBytes - writes nBytes from memory area src to a file
+ returning the number of bytes actually written.
+ This function will flush the buffer and then
+ write the nBytes using a direct write from libc.
+ It is ideal for large writes.
+*/
+
+extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src)
+{
+ int total;
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforwrite, TRUE);
+ FIO_FlushBuffer (f);
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ total = static_cast<int> (libc_write (fd->unixfd, src, static_cast<size_t> ((int ) (nBytes))));
+ if (total < 0)
+ {
+ fd->state = FIO_failed;
+ return 0;
+ }
+ else
+ {
+ fd->abspos += (unsigned int ) (total);
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->bufstart = fd->abspos;
+ }
+ return (unsigned int ) (total);
+ }
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WriteAny - writes HIGH(a) bytes onto, file, f. All output
+ is fully buffered, unlike WriteNBytes and thus is more
+ suited to small writes.
+*/
+
+extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high)
+{
+ CheckAccess (f, FIO_openedforwrite, TRUE);
+ if ((BufferedWrite (f, _a_high, a)) == ((int ) (_a_high)))
+ {} /* empty. */
+}
+
+
+/*
+ WriteChar - writes a single character to file, f.
+*/
+
+extern "C" void FIO_WriteChar (FIO_File f, char ch)
+{
+ CheckAccess (f, FIO_openedforwrite, TRUE);
+ if ((BufferedWrite (f, sizeof (ch), &ch)) == ((int ) (sizeof (ch))))
+ {} /* empty. */
+}
+
+
+/*
+ EOF - tests to see whether a file, f, has reached end of file.
+*/
+
+extern "C" unsigned int FIO_EOF (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ return fd->state == FIO_endoffile;
+ }
+ }
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ EOLN - tests to see whether a file, f, is upon a newline.
+ It does NOT consume the newline.
+*/
+
+extern "C" unsigned int FIO_EOLN (FIO_File f)
+{
+ char ch;
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ /*
+ we will read a character and then push it back onto the input stream,
+ having noted the file status, we also reset the status.
+ */
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ if ((fd->state == FIO_successful) || (fd->state == FIO_endofline))
+ {
+ ch = FIO_ReadChar (f);
+ if ((fd->state == FIO_successful) || (fd->state == FIO_endofline))
+ {
+ FIO_UnReadChar (f, ch);
+ }
+ return ch == ASCII_nl;
+ }
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WasEOLN - tests to see whether a file, f, has just seen a newline.
+*/
+
+extern "C" unsigned int FIO_WasEOLN (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if (f == Error)
+ {
+ return FALSE;
+ }
+ else
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ return (fd != NULL) && (fd->state == FIO_endofline);
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ReadChar - returns a character read from file f.
+ Sensible to check with IsNoError or EOF after calling
+ this function.
+*/
+
+extern "C" char FIO_ReadChar (FIO_File f)
+{
+ char ch;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if ((BufferedRead (f, sizeof (ch), &ch)) == ((int ) (sizeof (ch))))
+ {
+ SetEndOfLine (f, ch);
+ return ch;
+ }
+ else
+ {
+ return ASCII_nul;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ UnReadChar - replaces a character, ch, back into file f.
+ This character must have been read by ReadChar
+ and it does not allow successive calls. It may
+ only be called if the previous read was successful
+ or end of file was seen.
+ If the state was previously endoffile then it
+ is altered to successful.
+ Otherwise it is left alone.
+*/
+
+extern "C" void FIO_UnReadChar (FIO_File f, char ch)
+{
+ FIO_FileDescriptor fd;
+ unsigned int n;
+ void * a;
+ void * b;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (((fd->state == FIO_successful) || (fd->state == FIO_endoffile)) || (fd->state == FIO_endofline))
+ {
+ /* avoid dangling else. */
+ if ((fd->buffer != NULL) && fd->buffer->valid)
+ {
+ /* we assume that a ReadChar has occurred, we will check just in case. */
+ if (fd->state == FIO_endoffile)
+ {
+ fd->buffer->position = MaxBufferLength;
+ fd->buffer->left = 0;
+ fd->buffer->filled = 0;
+ fd->state = FIO_successful;
+ }
+ if (fd->buffer->position > 0)
+ {
+ fd->buffer->position -= 1;
+ fd->buffer->left += 1;
+ (*fd->buffer->contents).array[fd->buffer->position] = ch;
+ }
+ else
+ {
+ /* if possible make room and store ch */
+ if (fd->buffer->filled == fd->buffer->size)
+ {
+ FormatError1 ((const char *) "performing too many UnReadChar calls on file (%d)\\n", 51, (const unsigned char *) &f, (sizeof (f)-1));
+ }
+ else
+ {
+ n = fd->buffer->filled-fd->buffer->position;
+ b = &(*fd->buffer->contents).array[fd->buffer->position];
+ a = &(*fd->buffer->contents).array[fd->buffer->position+1];
+ a = libc_memcpy (a, b, static_cast<size_t> (n));
+ fd->buffer->filled += 1;
+ (*fd->buffer->contents).array[fd->buffer->position] = ch;
+ }
+ }
+ }
+ }
+ else
+ {
+ FormatError1 ((const char *) "UnReadChar can only be called if the previous read was successful or end of file, error on file (%d)\\n", 102, (const unsigned char *) &f, (sizeof (f)-1));
+ }
+ }
+}
+
+
+/*
+ WriteLine - writes out a linefeed to file, f.
+*/
+
+extern "C" void FIO_WriteLine (FIO_File f)
+{
+ FIO_WriteChar (f, ASCII_nl);
+}
+
+
+/*
+ WriteString - writes a string to file, f.
+*/
+
+extern "C" void FIO_WriteString (FIO_File f, const char *a_, unsigned int _a_high)
+{
+ unsigned int l;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ l = StrLib_StrLen ((const char *) a, _a_high);
+ if ((FIO_WriteNBytes (f, l, &a)) != l)
+ {} /* empty. */
+}
+
+
+/*
+ ReadString - reads a string from file, f, into string, a.
+ It terminates the string if HIGH is reached or
+ if a newline is seen or an error occurs.
+*/
+
+extern "C" void FIO_ReadString (FIO_File f, char *a, unsigned int _a_high)
+{
+ unsigned int high;
+ unsigned int i;
+ char ch;
+
+ CheckAccess (f, FIO_openedforread, FALSE);
+ high = _a_high;
+ i = 0;
+ do {
+ ch = FIO_ReadChar (f);
+ if (i <= high)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (((ch == ASCII_nl) || (! (FIO_IsNoError (f)))) || (FIO_EOF (f)))
+ {
+ a[i] = ASCII_nul;
+ i += 1;
+ }
+ else
+ {
+ a[i] = ch;
+ i += 1;
+ }
+ }
+ } while (! ((((ch == ASCII_nl) || (i > high)) || (! (FIO_IsNoError (f)))) || (FIO_EOF (f))));
+}
+
+
+/*
+ WriteCardinal - writes a CARDINAL to file, f.
+ It writes the binary image of the cardinal
+ to file, f.
+*/
+
+extern "C" void FIO_WriteCardinal (FIO_File f, unsigned int c)
+{
+ FIO_WriteAny (f, (unsigned char *) &c, (sizeof (c)-1));
+}
+
+
+/*
+ ReadCardinal - reads a CARDINAL from file, f.
+ It reads a binary image of a CARDINAL
+ from a file, f.
+*/
+
+extern "C" unsigned int FIO_ReadCardinal (FIO_File f)
+{
+ unsigned int c;
+
+ FIO_ReadAny (f, (unsigned char *) &c, (sizeof (c)-1));
+ return c;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetUnixFileDescriptor - returns the UNIX file descriptor of a file.
+*/
+
+extern "C" int FIO_GetUnixFileDescriptor (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ return fd->unixfd;
+ }
+ }
+ FormatError1 ((const char *) "file %d has not been opened or is out of range\\n", 48, (const unsigned char *) &f, (sizeof (f)-1));
+ return -1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetPositionFromBeginning - sets the position from the beginning of the file.
+*/
+
+extern "C" void FIO_SetPositionFromBeginning (FIO_File f, long int pos)
+{
+ long int offset;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ /* always force the lseek, until we are confident that abspos is always correct,
+ basically it needs some hard testing before we should remove the OR TRUE. */
+ if ((fd->abspos != pos) || TRUE)
+ {
+ FIO_FlushBuffer (f);
+ if (fd->buffer != NULL)
+ {
+ if (fd->output)
+ {
+ fd->buffer->left = fd->buffer->size;
+ }
+ else
+ {
+ fd->buffer->left = 0;
+ }
+ fd->buffer->position = 0;
+ fd->buffer->filled = 0;
+ }
+ offset = libc_lseek (fd->unixfd, pos, SEEK_SET);
+ if ((offset >= 0) && (pos == offset))
+ {
+ fd->abspos = pos;
+ }
+ else
+ {
+ fd->state = FIO_failed;
+ fd->abspos = 0;
+ }
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->bufstart = fd->abspos;
+ }
+ }
+ }
+ }
+}
+
+
+/*
+ SetPositionFromEnd - sets the position from the end of the file.
+*/
+
+extern "C" void FIO_SetPositionFromEnd (FIO_File f, long int pos)
+{
+ long int offset;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ FIO_FlushBuffer (f);
+ if (fd->buffer != NULL)
+ {
+ if (fd->output)
+ {
+ fd->buffer->left = fd->buffer->size;
+ }
+ else
+ {
+ fd->buffer->left = 0;
+ }
+ fd->buffer->position = 0;
+ fd->buffer->filled = 0;
+ }
+ offset = libc_lseek (fd->unixfd, pos, SEEK_END);
+ if (offset >= 0)
+ {
+ fd->abspos = offset;
+ }
+ else
+ {
+ fd->state = FIO_failed;
+ fd->abspos = 0;
+ offset = 0;
+ }
+ if (fd->buffer != NULL)
+ {
+ fd->buffer->valid = FALSE;
+ fd->buffer->bufstart = offset;
+ }
+ }
+ }
+}
+
+
+/*
+ FindPosition - returns the current absolute position in file, f.
+*/
+
+extern "C" long int FIO_FindPosition (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd != NULL)
+ {
+ if ((fd->buffer == NULL) || ! fd->buffer->valid)
+ {
+ return fd->abspos;
+ }
+ else
+ {
+ return fd->buffer->bufstart+((long int ) (fd->buffer->position));
+ }
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetFileName - assigns, a, with the filename associated with, f.
+*/
+
+extern "C" void FIO_GetFileName (FIO_File f, char *a, unsigned int _a_high)
+{
+ typedef char *GetFileName__T6;
+
+ unsigned int i;
+ GetFileName__T6 p;
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ if (fd->name.address == NULL)
+ {
+ StrLib_StrCopy ((const char *) "", 0, (char *) a, _a_high);
+ }
+ else
+ {
+ p = static_cast<GetFileName__T6> (fd->name.address);
+ i = 0;
+ while (((*p) != ASCII_nul) && (i <= _a_high))
+ {
+ a[i] = (*p);
+ p += 1;
+ i += 1;
+ }
+ }
+ }
+ }
+}
+
+
+/*
+ getFileName - returns the address of the filename associated with, f.
+*/
+
+extern "C" void * FIO_getFileName (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return fd->name.address;
+ }
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ getFileNameLength - returns the number of characters associated with filename, f.
+*/
+
+extern "C" unsigned int FIO_getFileNameLength (FIO_File f)
+{
+ FIO_FileDescriptor fd;
+
+ if (f != Error)
+ {
+ fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
+ if (fd == NULL)
+ {
+ FormatError ((const char *) "this file has probably been closed and not reopened successfully or alternatively never opened\\n", 96);
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return fd->name.size;
+ }
+ }
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FlushOutErr - flushes, StdOut, and, StdErr.
+ It is also called when the application calls M2RTS.Terminate.
+ (which is automatically placed in program modules by the GM2
+ scaffold).
+*/
+
+extern "C" void FIO_FlushOutErr (void)
+{
+ if (FIO_IsNoError (FIO_StdOut))
+ {
+ FIO_FlushBuffer (FIO_StdOut);
+ }
+ if (FIO_IsNoError (FIO_StdErr))
+ {
+ FIO_FlushBuffer (FIO_StdErr);
+ }
+}
+
+extern "C" void _M2_FIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Init ();
+}
+
+extern "C" void _M2_FIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ FIO_FlushOutErr ();
+}
diff --git a/gcc/m2/mc-boot/GFormatStrings.cc b/gcc/m2/mc-boot/GFormatStrings.cc
new file mode 100644
index 00000000000..78e7a5a559c
--- /dev/null
+++ b/gcc/m2/mc-boot/GFormatStrings.cc
@@ -0,0 +1,845 @@
+/* do not edit automatically generated by mc from FormatStrings. */
+/* FormatStrings.mod provides a pseudo printf capability.
+
+Copyright (C) 2005-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _FormatStrings_H
+#define _FormatStrings_C
+
+# include "GDynamicStrings.h"
+# include "GStringConvert.h"
+# include "GSYSTEM.h"
+# include "GASCII.h"
+# include "GM2RTS.h"
+
+
+/*
+ Sprintf0 - returns a String containing, s, after it has had its
+ escape sequences translated.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt);
+
+/*
+ Sprintf1 - returns a String containing, s, together with encapsulated
+ entity, w. It only formats the first %s or %d with n.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ Sprintf2 - returns a string, s, which has been formatted.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf2 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high);
+
+/*
+ Sprintf3 - returns a string, s, which has been formatted.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf3 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high);
+
+/*
+ Sprintf4 - returns a string, s, which has been formatted.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf4 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high);
+
+/*
+ HandleEscape - translates \a, \b, \e, \f,
+, \r, \x[hex] \[octal] into
+ their respective ascii codes. It also converts \[any] into
+ a single [any] character.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_HandleEscape (DynamicStrings_String s);
+
+/*
+ doDSdbEnter -
+*/
+
+static void doDSdbEnter (void);
+
+/*
+ doDSdbExit -
+*/
+
+static void doDSdbExit (DynamicStrings_String s);
+
+/*
+ DSdbEnter -
+*/
+
+static void DSdbEnter (void);
+
+/*
+ DSdbExit -
+*/
+
+static void DSdbExit (DynamicStrings_String s);
+
+/*
+ IsDigit - returns TRUE if ch lies in the range: 0..9
+*/
+
+static unsigned int IsDigit (char ch);
+
+/*
+ Cast - casts a := b
+*/
+
+static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high);
+
+/*
+ isHex -
+*/
+
+static unsigned int isHex (char ch);
+
+/*
+ toHex -
+*/
+
+static unsigned int toHex (char ch);
+
+/*
+ toOct -
+*/
+
+static unsigned int toOct (char ch);
+
+/*
+ isOct -
+*/
+
+static unsigned int isOct (char ch);
+
+/*
+ FormatString - returns a String containing, s, together with encapsulated
+ entity, w. It only formats the first %s or %d or %u with n.
+ A new string is returned.
+*/
+
+static DynamicStrings_String FormatString (DynamicStrings_String fmt, int *startpos, DynamicStrings_String in, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ FormatString - returns a String containing, s, together with encapsulated
+ entity, w. It only formats the first %s or %d or %u with n.
+ A new string is returned.
+*/
+
+static DynamicStrings_String PerformFormatString (DynamicStrings_String fmt, int *startpos, DynamicStrings_String in, const unsigned char *w_, unsigned int _w_high);
+
+/*
+ Copy - copies, fmt[start:end] -> in and returns in. Providing that start >= 0.
+*/
+
+static DynamicStrings_String Copy (DynamicStrings_String fmt, DynamicStrings_String in, int start, int end);
+
+/*
+ HandlePercent - pre-condition: s, is a string.
+ Post-condition: a new string is returned which is a copy of,
+ s, except %% is transformed into %.
+*/
+
+static DynamicStrings_String HandlePercent (DynamicStrings_String fmt, DynamicStrings_String s, int startpos);
+
+
+/*
+ doDSdbEnter -
+*/
+
+static void doDSdbEnter (void)
+{
+ DynamicStrings_PushAllocation ();
+}
+
+
+/*
+ doDSdbExit -
+*/
+
+static void doDSdbExit (DynamicStrings_String s)
+{
+ s = DynamicStrings_PopAllocationExemption (TRUE, s);
+}
+
+
+/*
+ DSdbEnter -
+*/
+
+static void DSdbEnter (void)
+{
+}
+
+
+/*
+ DSdbExit -
+*/
+
+static void DSdbExit (DynamicStrings_String s)
+{
+}
+
+
+/*
+ IsDigit - returns TRUE if ch lies in the range: 0..9
+*/
+
+static unsigned int IsDigit (char ch)
+{
+ return (ch >= '0') && (ch <= '9');
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Cast - casts a := b
+*/
+
+static void Cast (unsigned char *a, unsigned int _a_high, const unsigned char *b_, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (b, b_, _b_high+1);
+
+ if (_a_high == _b_high)
+ {
+ for (i=0; i<=_a_high; i++)
+ {
+ a[i] = b[i];
+ }
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ isHex -
+*/
+
+static unsigned int isHex (char ch)
+{
+ return (((ch >= '0') && (ch <= '9')) || ((ch >= 'A') && (ch <= 'F'))) || ((ch >= 'a') && (ch <= 'f'));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ toHex -
+*/
+
+static unsigned int toHex (char ch)
+{
+ if ((ch >= '0') && (ch <= '9'))
+ {
+ return ((unsigned int) (ch))- ((unsigned int) ('0'));
+ }
+ else if ((ch >= 'A') && (ch <= 'F'))
+ {
+ /* avoid dangling else. */
+ return ( ((unsigned int) (ch))- ((unsigned int) ('A')))+10;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return ( ((unsigned int) (ch))- ((unsigned int) ('a')))+10;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ toOct -
+*/
+
+static unsigned int toOct (char ch)
+{
+ return ((unsigned int) (ch))- ((unsigned int) ('0'));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ isOct -
+*/
+
+static unsigned int isOct (char ch)
+{
+ return (ch >= '0') && (ch <= '8');
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FormatString - returns a String containing, s, together with encapsulated
+ entity, w. It only formats the first %s or %d or %u with n.
+ A new string is returned.
+*/
+
+static DynamicStrings_String FormatString (DynamicStrings_String fmt, int *startpos, DynamicStrings_String in, const unsigned char *w_, unsigned int _w_high)
+{
+ DynamicStrings_String s;
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (w, w_, _w_high+1);
+
+ DSdbEnter ();
+ if ((*startpos) >= 0)
+ {
+ s = PerformFormatString (fmt, startpos, in, (const unsigned char *) w, _w_high);
+ }
+ else
+ {
+ s = DynamicStrings_Dup (in);
+ }
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FormatString - returns a String containing, s, together with encapsulated
+ entity, w. It only formats the first %s or %d or %u with n.
+ A new string is returned.
+*/
+
+static DynamicStrings_String PerformFormatString (DynamicStrings_String fmt, int *startpos, DynamicStrings_String in, const unsigned char *w_, unsigned int _w_high)
+{
+ unsigned int left;
+ unsigned int u;
+ int c;
+ int width;
+ int nextperc;
+ int afterperc;
+ int endpos;
+ char leader;
+ char ch;
+ char ch2;
+ DynamicStrings_String p;
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (w, w_, _w_high+1);
+
+ while ((*startpos) >= 0)
+ {
+ nextperc = DynamicStrings_Index (fmt, '%', static_cast<unsigned int> ((*startpos)));
+ afterperc = nextperc;
+ if (nextperc >= 0)
+ {
+ afterperc += 1;
+ if ((DynamicStrings_char (fmt, afterperc)) == '-')
+ {
+ left = TRUE;
+ afterperc += 1;
+ }
+ else
+ {
+ left = FALSE;
+ }
+ ch = DynamicStrings_char (fmt, afterperc);
+ if (ch == '0')
+ {
+ leader = '0';
+ }
+ else
+ {
+ leader = ' ';
+ }
+ width = 0;
+ while (IsDigit (ch))
+ {
+ width = (width*10)+((int ) ( ((unsigned int) (ch))- ((unsigned int) ('0'))));
+ afterperc += 1;
+ ch = DynamicStrings_char (fmt, afterperc);
+ }
+ if ((ch == 'c') || (ch == 's'))
+ {
+ afterperc += 1;
+ if (ch == 'c')
+ {
+ ch2 = static_cast<char> (w[0]);
+ p = DynamicStrings_ConCatChar (DynamicStrings_InitString ((const char *) "", 0), ch2);
+ }
+ else
+ {
+ Cast ((unsigned char *) &p, (sizeof (p)-1), (const unsigned char *) w, _w_high);
+ p = DynamicStrings_Dup (p);
+ }
+ if ((width > 0) && (((int ) (DynamicStrings_Length (p))) < width))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (left)
+ {
+ /* place trailing spaces after, p. */
+ p = DynamicStrings_ConCat (p, DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " ", 1)), static_cast<unsigned int> (width-((int ) (DynamicStrings_Length (p)))))));
+ }
+ else
+ {
+ /* padd string, p, with leading spaces. */
+ p = DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitString ((const char *) " ", 1)), static_cast<unsigned int> (width-((int ) (DynamicStrings_Length (p))))), DynamicStrings_Mark (p));
+ }
+ }
+ /* include string, p, into, in. */
+ if (nextperc > 0)
+ {
+ in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt, (*startpos), nextperc));
+ }
+ in = DynamicStrings_ConCat (in, p);
+ (*startpos) = afterperc;
+ DSdbExit (static_cast<DynamicStrings_String> (NULL));
+ return in;
+ }
+ else if (ch == 'd')
+ {
+ /* avoid dangling else. */
+ afterperc += 1;
+ Cast ((unsigned char *) &c, (sizeof (c)-1), (const unsigned char *) w, _w_high);
+ in = Copy (fmt, in, (*startpos), nextperc);
+ in = DynamicStrings_ConCat (in, StringConvert_IntegerToString (c, static_cast<unsigned int> (width), leader, FALSE, 10, FALSE));
+ (*startpos) = afterperc;
+ DSdbExit (static_cast<DynamicStrings_String> (NULL));
+ return in;
+ }
+ else if (ch == 'x')
+ {
+ /* avoid dangling else. */
+ afterperc += 1;
+ Cast ((unsigned char *) &u, (sizeof (u)-1), (const unsigned char *) w, _w_high);
+ in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt, (*startpos), nextperc));
+ in = DynamicStrings_ConCat (in, StringConvert_CardinalToString (u, static_cast<unsigned int> (width), leader, 16, TRUE));
+ (*startpos) = afterperc;
+ DSdbExit (static_cast<DynamicStrings_String> (NULL));
+ return in;
+ }
+ else if (ch == 'u')
+ {
+ /* avoid dangling else. */
+ afterperc += 1;
+ Cast ((unsigned char *) &u, (sizeof (u)-1), (const unsigned char *) w, _w_high);
+ in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt, (*startpos), nextperc));
+ in = DynamicStrings_ConCat (in, StringConvert_CardinalToString (u, static_cast<unsigned int> (width), leader, 10, FALSE));
+ (*startpos) = afterperc;
+ DSdbExit (static_cast<DynamicStrings_String> (NULL));
+ return in;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ afterperc += 1;
+ /* copy format string. */
+ if (nextperc > 0)
+ {
+ in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt, (*startpos), nextperc));
+ }
+ /* and the character after the %. */
+ in = DynamicStrings_ConCat (in, DynamicStrings_Mark (DynamicStrings_InitStringChar (ch)));
+ }
+ (*startpos) = afterperc;
+ }
+ else
+ {
+ /* nothing to do. */
+ DSdbExit (static_cast<DynamicStrings_String> (NULL));
+ return in;
+ }
+ }
+ DSdbExit (static_cast<DynamicStrings_String> (NULL));
+ return in;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Copy - copies, fmt[start:end] -> in and returns in. Providing that start >= 0.
+*/
+
+static DynamicStrings_String Copy (DynamicStrings_String fmt, DynamicStrings_String in, int start, int end)
+{
+ if (start >= 0)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (end > 0)
+ {
+ in = DynamicStrings_ConCat (in, DynamicStrings_Mark (DynamicStrings_Slice (fmt, start, end)));
+ }
+ else if (end < 0)
+ {
+ /* avoid dangling else. */
+ in = DynamicStrings_ConCat (in, DynamicStrings_Mark (DynamicStrings_Slice (fmt, start, 0)));
+ }
+ }
+ return in;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ HandlePercent - pre-condition: s, is a string.
+ Post-condition: a new string is returned which is a copy of,
+ s, except %% is transformed into %.
+*/
+
+static DynamicStrings_String HandlePercent (DynamicStrings_String fmt, DynamicStrings_String s, int startpos)
+{
+ int prevpos;
+ DynamicStrings_String result;
+
+ if ((startpos == ((int ) (DynamicStrings_Length (fmt)))) || (startpos < 0))
+ {
+ return s;
+ }
+ else
+ {
+ prevpos = startpos;
+ while ((startpos >= 0) && (prevpos < ((int ) (DynamicStrings_Length (fmt)))))
+ {
+ startpos = DynamicStrings_Index (fmt, '%', static_cast<unsigned int> (startpos));
+ if (startpos >= prevpos)
+ {
+ if (startpos > 0)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Slice (fmt, prevpos, startpos)));
+ }
+ startpos += 1;
+ if ((DynamicStrings_char (fmt, startpos)) == '%')
+ {
+ s = DynamicStrings_ConCatChar (s, '%');
+ startpos += 1;
+ }
+ prevpos = startpos;
+ }
+ }
+ if (prevpos < ((int ) (DynamicStrings_Length (fmt))))
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_Slice (fmt, prevpos, 0)));
+ }
+ return s;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Sprintf0 - returns a String containing, s, after it has had its
+ escape sequences translated.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt)
+{
+ DynamicStrings_String s;
+
+ DSdbEnter ();
+ fmt = FormatStrings_HandleEscape (fmt);
+ s = HandlePercent (fmt, DynamicStrings_InitString ((const char *) "", 0), 0);
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Sprintf1 - returns a String containing, s, together with encapsulated
+ entity, w. It only formats the first %s or %d with n.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high)
+{
+ int i;
+ DynamicStrings_String s;
+ unsigned char w[_w_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (w, w_, _w_high+1);
+
+ DSdbEnter ();
+ fmt = FormatStrings_HandleEscape (fmt);
+ i = 0;
+ s = FormatString (fmt, &i, DynamicStrings_InitString ((const char *) "", 0), (const unsigned char *) w, _w_high);
+ s = HandlePercent (fmt, s, i);
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Sprintf2 - returns a string, s, which has been formatted.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf2 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high)
+{
+ int i;
+ DynamicStrings_String s;
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+
+ DSdbEnter ();
+ fmt = FormatStrings_HandleEscape (fmt);
+ i = 0;
+ s = FormatString (fmt, &i, DynamicStrings_InitString ((const char *) "", 0), (const unsigned char *) w1, _w1_high);
+ s = FormatString (fmt, &i, s, (const unsigned char *) w2, _w2_high);
+ s = HandlePercent (fmt, s, i);
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Sprintf3 - returns a string, s, which has been formatted.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf3 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high)
+{
+ int i;
+ DynamicStrings_String s;
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+ unsigned char w3[_w3_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+ memcpy (w3, w3_, _w3_high+1);
+
+ DSdbEnter ();
+ fmt = FormatStrings_HandleEscape (fmt);
+ i = 0;
+ s = FormatString (fmt, &i, DynamicStrings_InitString ((const char *) "", 0), (const unsigned char *) w1, _w1_high);
+ s = FormatString (fmt, &i, s, (const unsigned char *) w2, _w2_high);
+ s = FormatString (fmt, &i, s, (const unsigned char *) w3, _w3_high);
+ s = HandlePercent (fmt, s, i);
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Sprintf4 - returns a string, s, which has been formatted.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_Sprintf4 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high, const unsigned char *w3_, unsigned int _w3_high, const unsigned char *w4_, unsigned int _w4_high)
+{
+ int i;
+ DynamicStrings_String s;
+ unsigned char w1[_w1_high+1];
+ unsigned char w2[_w2_high+1];
+ unsigned char w3[_w3_high+1];
+ unsigned char w4[_w4_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (w1, w1_, _w1_high+1);
+ memcpy (w2, w2_, _w2_high+1);
+ memcpy (w3, w3_, _w3_high+1);
+ memcpy (w4, w4_, _w4_high+1);
+
+ DSdbEnter ();
+ fmt = FormatStrings_HandleEscape (fmt);
+ i = 0;
+ s = FormatString (fmt, &i, DynamicStrings_InitString ((const char *) "", 0), (const unsigned char *) w1, _w1_high);
+ s = FormatString (fmt, &i, s, (const unsigned char *) w2, _w2_high);
+ s = FormatString (fmt, &i, s, (const unsigned char *) w3, _w3_high);
+ s = FormatString (fmt, &i, s, (const unsigned char *) w4, _w4_high);
+ s = HandlePercent (fmt, s, i);
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ HandleEscape - translates \a, \b, \e, \f,
+, \r, \x[hex] \[octal] into
+ their respective ascii codes. It also converts \[any] into
+ a single [any] character.
+*/
+
+extern "C" DynamicStrings_String FormatStrings_HandleEscape (DynamicStrings_String s)
+{
+ DynamicStrings_String d;
+ int i;
+ int j;
+ char ch;
+ unsigned char b;
+
+ DSdbEnter ();
+ d = DynamicStrings_InitString ((const char *) "", 0);
+ i = DynamicStrings_Index (s, '\\', 0);
+ j = 0;
+ while (i >= 0)
+ {
+ if (i > 0)
+ {
+ /* initially i might be zero which means the end of the string, which is not what we want. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Slice (s, j, i));
+ }
+ ch = DynamicStrings_char (s, i+1);
+ if (ch == 'a')
+ {
+ /* requires a bell. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_bel)));
+ }
+ else if (ch == 'b')
+ {
+ /* avoid dangling else. */
+ /* requires a backspace. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_bs)));
+ }
+ else if (ch == 'e')
+ {
+ /* avoid dangling else. */
+ /* requires a escape. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_esc)));
+ }
+ else if (ch == 'f')
+ {
+ /* avoid dangling else. */
+ /* requires a formfeed. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_ff)));
+ }
+ else if (ch == 'n')
+ {
+ /* avoid dangling else. */
+ /* requires a newline. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_nl)));
+ }
+ else if (ch == 'r')
+ {
+ /* avoid dangling else. */
+ /* requires a carriage return. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_cr)));
+ }
+ else if (ch == 't')
+ {
+ /* avoid dangling else. */
+ /* requires a tab. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ASCII_tab)));
+ }
+ else if (ch == 'x')
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if (isHex (DynamicStrings_char (s, i+1)))
+ {
+ b = (unsigned char ) (toHex (DynamicStrings_char (s, i+1)));
+ i += 1;
+ if (isHex (DynamicStrings_char (s, i+1)))
+ {
+ b = (unsigned char ) ((((unsigned int ) (b))*0x010)+(toHex (DynamicStrings_char (s, i+1))));
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar ((char ) (b))));
+ }
+ }
+ }
+ else if (isOct (ch))
+ {
+ /* avoid dangling else. */
+ b = (unsigned char ) (toOct (ch));
+ i += 1;
+ if (isOct (DynamicStrings_char (s, i+1)))
+ {
+ b = (unsigned char ) ((((unsigned int ) (b))*8)+(toOct (DynamicStrings_char (s, i+1))));
+ i += 1;
+ if (isOct (DynamicStrings_char (s, i+1)))
+ {
+ b = (unsigned char ) ((((unsigned int ) (b))*8)+(toOct (DynamicStrings_char (s, i+1))));
+ }
+ }
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar ((char ) (b))));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ /* copy escaped character. */
+ d = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_InitStringChar (ch)));
+ }
+ i += 2;
+ j = i;
+ i = DynamicStrings_Index (s, '\\', (unsigned int ) (i));
+ }
+ /* s := Assign(s, Mark(ConCat(d, Mark(Slice(s, j, 0))))) ; dont Mark(s) in the Slice as we Assign contents */
+ s = DynamicStrings_ConCat (d, DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), j, 0)));
+ DSdbExit (s);
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_FormatStrings_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_FormatStrings_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GFpuIO.cc b/gcc/m2/mc-boot/GFpuIO.cc
new file mode 100644
index 00000000000..205c27b811e
--- /dev/null
+++ b/gcc/m2/mc-boot/GFpuIO.cc
@@ -0,0 +1,336 @@
+/* do not edit automatically generated by mc from FpuIO. */
+/* FpuIO.mod implements a fixed format input/output for REAL/LONGREAL.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#define _FpuIO_H
+#define _FpuIO_C
+
+# include "GStrIO.h"
+# include "GStrLib.h"
+# include "GASCII.h"
+# include "GDynamicStrings.h"
+# include "GStringConvert.h"
+
+# define MaxLineLength 100
+extern "C" void FpuIO_ReadReal (double *x);
+
+/*
+ WriteReal - converts a REAL number, x, which has a, TotalWidth, and
+ FractionWidth into, string, a.
+*/
+
+extern "C" void FpuIO_WriteReal (double x, unsigned int TotalWidth, unsigned int FractionWidth);
+
+/*
+ WriteReal - converts a REAL number, x, which has a, TotalWidth, and
+ FractionWidth into, string, a.
+*/
+
+extern "C" void FpuIO_StrToReal (const char *a_, unsigned int _a_high, double *x);
+
+/*
+ RealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_RealToStr (double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high);
+extern "C" void FpuIO_ReadLongReal (long double *x);
+
+/*
+ WriteLongReal - converts a LONGREAL number, x, which has a, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_WriteLongReal (long double x, unsigned int TotalWidth, unsigned int FractionWidth);
+
+/*
+ WriteLongReal - converts a LONGREAL number, x, which has a, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_StrToLongReal (const char *a_, unsigned int _a_high, long double *x);
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_LongRealToStr (long double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high);
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_ReadLongInt (long int *x);
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_WriteLongInt (long int x, unsigned int n);
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_StrToLongInt (const char *a_, unsigned int _a_high, long int *x);
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_LongIntToStr (long int x, unsigned int n, char *a, unsigned int _a_high);
+
+extern "C" void FpuIO_ReadReal (double *x)
+{
+ typedef struct ReadReal__T1_a ReadReal__T1;
+
+ struct ReadReal__T1_a { char array[MaxLineLength+1]; };
+ ReadReal__T1 a;
+
+ /*
+#undef GM2_DEBUG_FPUIO
+if defined(GM2_DEBUG_FPUIO)
+# define InitString(X) InitStringDB(X, __FILE__, __LINE__)
+# define InitStringCharStar(X) InitStringCharStarDB(X, __FILE__, __LINE__)
+# define InitStringChar(X) InitStringCharDB(X, __FILE__, __LINE__)
+# define Mult(X,Y) MultDB(X, Y, __FILE__, __LINE__)
+# define Dup(X) DupDB(X, __FILE__, __LINE__)
+# define Slice(X,Y,Z) SliceDB(X, Y, Z, __FILE__, __LINE__)
+#endif
+ */
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ FpuIO_StrToReal ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+
+/*
+ WriteReal - converts a REAL number, x, which has a, TotalWidth, and
+ FractionWidth into, string, a.
+*/
+
+extern "C" void FpuIO_WriteReal (double x, unsigned int TotalWidth, unsigned int FractionWidth)
+{
+ typedef struct WriteReal__T2_a WriteReal__T2;
+
+ struct WriteReal__T2_a { char array[MaxLineLength+1]; };
+ WriteReal__T2 a;
+
+ FpuIO_RealToStr (x, TotalWidth, FractionWidth, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+
+/*
+ WriteReal - converts a REAL number, x, which has a, TotalWidth, and
+ FractionWidth into, string, a.
+*/
+
+extern "C" void FpuIO_StrToReal (const char *a_, unsigned int _a_high, double *x)
+{
+ long double lr;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ FpuIO_StrToLongReal ((const char *) a, _a_high, &lr); /* let StrToLongReal do the work and we convert the result back to REAL */
+ (*x) = (double ) (lr); /* let StrToLongReal do the work and we convert the result back to REAL */
+}
+
+
+/*
+ RealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_RealToStr (double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high)
+{
+ long double lr;
+
+ lr = (long double ) (x);
+ FpuIO_LongRealToStr (lr, TotalWidth, FractionWidth, (char *) a, _a_high);
+}
+
+extern "C" void FpuIO_ReadLongReal (long double *x)
+{
+ typedef struct ReadLongReal__T3_a ReadLongReal__T3;
+
+ struct ReadLongReal__T3_a { char array[MaxLineLength+1]; };
+ ReadLongReal__T3 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ FpuIO_StrToLongReal ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+
+/*
+ WriteLongReal - converts a LONGREAL number, x, which has a, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_WriteLongReal (long double x, unsigned int TotalWidth, unsigned int FractionWidth)
+{
+ typedef struct WriteLongReal__T4_a WriteLongReal__T4;
+
+ struct WriteLongReal__T4_a { char array[MaxLineLength+1]; };
+ WriteLongReal__T4 a;
+
+ FpuIO_LongRealToStr (x, TotalWidth, FractionWidth, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+
+/*
+ WriteLongReal - converts a LONGREAL number, x, which has a, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_StrToLongReal (const char *a_, unsigned int _a_high, long double *x)
+{
+ unsigned int found;
+ DynamicStrings_String s;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ s = DynamicStrings_InitString ((const char *) a, _a_high);
+ (*x) = StringConvert_StringToLongreal (s, &found);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_LongRealToStr (long double x, unsigned int TotalWidth, unsigned int FractionWidth, char *a, unsigned int _a_high)
+{
+ DynamicStrings_String s;
+
+ s = StringConvert_LongrealToString (x, TotalWidth, FractionWidth);
+ DynamicStrings_CopyOut ((char *) a, _a_high, s);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_ReadLongInt (long int *x)
+{
+ typedef struct ReadLongInt__T5_a ReadLongInt__T5;
+
+ struct ReadLongInt__T5_a { char array[MaxLineLength+1]; };
+ ReadLongInt__T5 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ FpuIO_StrToLongInt ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_WriteLongInt (long int x, unsigned int n)
+{
+ typedef struct WriteLongInt__T6_a WriteLongInt__T6;
+
+ struct WriteLongInt__T6_a { char array[MaxLineLength+1]; };
+ WriteLongInt__T6 a;
+
+ FpuIO_LongIntToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_StrToLongInt (const char *a_, unsigned int _a_high, long int *x)
+{
+ DynamicStrings_String s;
+ unsigned int found;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ s = DynamicStrings_InitString ((const char *) a, _a_high);
+ (*x) = StringConvert_StringToLongInteger (s, 10, &found);
+ s = DynamicStrings_KillString (s);
+}
+
+
+/*
+ LongRealToStr - converts a LONGREAL number, Real, which has, TotalWidth, and
+ FractionWidth into a string.
+*/
+
+extern "C" void FpuIO_LongIntToStr (long int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ DynamicStrings_String s;
+
+ s = StringConvert_LongIntegerToString (x, n, ' ', FALSE, 10, TRUE);
+ DynamicStrings_CopyOut ((char *) a, _a_high, s);
+ s = DynamicStrings_KillString (s);
+}
+
+extern "C" void _M2_FpuIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_FpuIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GIO.cc b/gcc/m2/mc-boot/GIO.cc
new file mode 100644
index 00000000000..e56c74382f5
--- /dev/null
+++ b/gcc/m2/mc-boot/GIO.cc
@@ -0,0 +1,479 @@
+/* do not edit automatically generated by mc from IO. */
+/* IO.mod provides Read, Write, Errors procedures mapping onto 0, 1 and 2.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#define _IO_H
+#define _IO_C
+
+# include "GStrLib.h"
+# include "GSYSTEM.h"
+# include "Glibc.h"
+# include "GFIO.h"
+# include "Gerrno.h"
+# include "GASCII.h"
+# include "Gtermios.h"
+
+# define MaxDefaultFd 2
+typedef struct IO_BasicFds_r IO_BasicFds;
+
+typedef struct IO__T1_a IO__T1;
+
+struct IO_BasicFds_r {
+ unsigned int IsEof;
+ unsigned int IsRaw;
+ };
+
+struct IO__T1_a { IO_BasicFds array[MaxDefaultFd+1]; };
+static IO__T1 fdState;
+
+/*
+ IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2.
+*/
+
+extern "C" void IO_Read (char *ch);
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+extern "C" void IO_Write (char ch);
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+extern "C" void IO_Error (char ch);
+extern "C" void IO_UnBufferedMode (int fd, unsigned int input);
+extern "C" void IO_BufferedMode (int fd, unsigned int input);
+
+/*
+ EchoOn - turns on echoing for file descriptor, fd. This
+ only really makes sence for a file descriptor opened
+ for terminal input or maybe some specific file descriptor
+ which is attached to a particular piece of hardware.
+*/
+
+extern "C" void IO_EchoOn (int fd, unsigned int input);
+
+/*
+ EchoOff - turns off echoing for file descriptor, fd. This
+ only really makes sence for a file descriptor opened
+ for terminal input or maybe some specific file descriptor
+ which is attached to a particular piece of hardware.
+*/
+
+extern "C" void IO_EchoOff (int fd, unsigned int input);
+
+/*
+ IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2.
+*/
+
+static unsigned int IsDefaultFd (int fd);
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+static void doWrite (int fd, FIO_File f, char ch);
+
+/*
+ setFlag - sets or unsets the appropriate flag in, t.
+*/
+
+static void setFlag (termios_TERMIOS t, termios_Flag f, unsigned int b);
+
+/*
+ doraw - sets all the flags associated with making this
+ file descriptor into raw input/output.
+*/
+
+static void doraw (termios_TERMIOS term);
+
+/*
+ dononraw - sets all the flags associated with making this
+ file descriptor into non raw input/output.
+*/
+
+static void dononraw (termios_TERMIOS term);
+
+/*
+ Init -
+*/
+
+static void Init (void);
+
+
+/*
+ IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2.
+*/
+
+static unsigned int IsDefaultFd (int fd)
+{
+ return (fd <= MaxDefaultFd) && (fd >= 0);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+static void doWrite (int fd, FIO_File f, char ch)
+{
+ int r;
+
+ if (fdState.array[fd].IsRaw)
+ {
+ /* avoid dangling else. */
+ if (! fdState.array[fd].IsEof)
+ {
+ for (;;)
+ {
+ r = static_cast<int> (libc_write (FIO_GetUnixFileDescriptor (f), &ch, static_cast<size_t> (1)));
+ if (r == 1)
+ {
+ return ;
+ }
+ else if (r == -1)
+ {
+ /* avoid dangling else. */
+ r = errno_geterrno ();
+ if ((r != errno_EAGAIN) && (r != errno_EINTR))
+ {
+ fdState.array[fd].IsEof = TRUE;
+ return ;
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ FIO_WriteChar (f, ch);
+ }
+}
+
+
+/*
+ setFlag - sets or unsets the appropriate flag in, t.
+*/
+
+static void setFlag (termios_TERMIOS t, termios_Flag f, unsigned int b)
+{
+ if (termios_SetFlag (t, f, b))
+ {} /* empty. */
+}
+
+
+/*
+ doraw - sets all the flags associated with making this
+ file descriptor into raw input/output.
+*/
+
+static void doraw (termios_TERMIOS term)
+{
+ /*
+ * from man 3 termios
+ * termios_p->c_iflag &= ~(IGNBRK | BRKINT | PARMRK | ISTRIP
+ * | INLCR | IGNCR | ICRNL | IXON);
+ * termios_p->c_oflag &= ~OPOST;
+ * termios_p->c_lflag &= ~(ECHO | ECHONL | ICANON | ISIG | IEXTEN);
+ * termios_p->c_cflag &= ~(CSIZE | PARENB);
+ * termios_p->c_cflag |= CS8;
+ */
+ setFlag (term, termios_ignbrk, FALSE);
+ setFlag (term, termios_ibrkint, FALSE);
+ setFlag (term, termios_iparmrk, FALSE);
+ setFlag (term, termios_istrip, FALSE);
+ setFlag (term, termios_inlcr, FALSE);
+ setFlag (term, termios_igncr, FALSE);
+ setFlag (term, termios_icrnl, FALSE);
+ setFlag (term, termios_ixon, FALSE);
+ setFlag (term, termios_opost, FALSE);
+ setFlag (term, termios_lecho, FALSE);
+ setFlag (term, termios_lechonl, FALSE);
+ setFlag (term, termios_licanon, FALSE);
+ setFlag (term, termios_lisig, FALSE);
+ setFlag (term, termios_liexten, FALSE);
+ setFlag (term, termios_parenb, FALSE);
+ setFlag (term, termios_cs8, TRUE);
+}
+
+
+/*
+ dononraw - sets all the flags associated with making this
+ file descriptor into non raw input/output.
+*/
+
+static void dononraw (termios_TERMIOS term)
+{
+ /*
+ * we undo these settings, (although we leave the character size alone)
+ *
+ * from man 3 termios
+ * termios_p->c_iflag &= ~(IGNBRK | BRKINT | PARMRK | ISTRIP
+ * | INLCR | IGNCR | ICRNL | IXON);
+ * termios_p->c_oflag &= ~OPOST;
+ * termios_p->c_lflag &= ~(ECHO | ECHONL | ICANON | ISIG | IEXTEN);
+ * termios_p->c_cflag &= ~(CSIZE | PARENB);
+ * termios_p->c_cflag |= CS8;
+ */
+ setFlag (term, termios_ignbrk, TRUE);
+ setFlag (term, termios_ibrkint, TRUE);
+ setFlag (term, termios_iparmrk, TRUE);
+ setFlag (term, termios_istrip, TRUE);
+ setFlag (term, termios_inlcr, TRUE);
+ setFlag (term, termios_igncr, TRUE);
+ setFlag (term, termios_icrnl, TRUE);
+ setFlag (term, termios_ixon, TRUE);
+ setFlag (term, termios_opost, TRUE);
+ setFlag (term, termios_lecho, TRUE);
+ setFlag (term, termios_lechonl, TRUE);
+ setFlag (term, termios_licanon, TRUE);
+ setFlag (term, termios_lisig, TRUE);
+ setFlag (term, termios_liexten, TRUE);
+}
+
+
+/*
+ Init -
+*/
+
+static void Init (void)
+{
+ fdState.array[0].IsEof = FALSE;
+ fdState.array[0].IsRaw = FALSE;
+ fdState.array[1].IsEof = FALSE;
+ fdState.array[1].IsRaw = FALSE;
+ fdState.array[2].IsEof = FALSE;
+ fdState.array[2].IsRaw = FALSE;
+}
+
+
+/*
+ IsDefaultFd - returns TRUE if, fd, is 0, 1 or 2.
+*/
+
+extern "C" void IO_Read (char *ch)
+{
+ int r;
+
+ FIO_FlushBuffer (FIO_StdOut);
+ FIO_FlushBuffer (FIO_StdErr);
+ if (fdState.array[0].IsRaw)
+ {
+ if (fdState.array[0].IsEof)
+ {
+ (*ch) = ASCII_eof;
+ }
+ else
+ {
+ for (;;)
+ {
+ r = static_cast<int> (libc_read (FIO_GetUnixFileDescriptor (FIO_StdIn), ch, static_cast<size_t> (1)));
+ if (r == 1)
+ {
+ return ;
+ }
+ else if (r == -1)
+ {
+ /* avoid dangling else. */
+ r = errno_geterrno ();
+ if (r != errno_EAGAIN)
+ {
+ fdState.array[0].IsEof = TRUE;
+ (*ch) = ASCII_eof;
+ return ;
+ }
+ }
+ }
+ }
+ }
+ else
+ {
+ (*ch) = FIO_ReadChar (FIO_StdIn);
+ }
+}
+
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+extern "C" void IO_Write (char ch)
+{
+ doWrite (1, FIO_StdOut, ch);
+}
+
+
+/*
+ doWrite - performs the write of a single character, ch,
+ onto fd or f.
+*/
+
+extern "C" void IO_Error (char ch)
+{
+ doWrite (2, FIO_StdErr, ch);
+}
+
+extern "C" void IO_UnBufferedMode (int fd, unsigned int input)
+{
+ termios_TERMIOS term;
+ int result;
+
+ if (IsDefaultFd (fd))
+ {
+ fdState.array[fd].IsRaw = TRUE;
+ }
+ term = termios_InitTermios ();
+ if ((termios_tcgetattr (fd, term)) == 0)
+ {
+ doraw (term);
+ if (input)
+ {
+ result = termios_tcsetattr (fd, termios_tcsflush (), term);
+ }
+ else
+ {
+ result = termios_tcsetattr (fd, termios_tcsdrain (), term);
+ }
+ }
+ term = termios_KillTermios (term);
+}
+
+extern "C" void IO_BufferedMode (int fd, unsigned int input)
+{
+ termios_TERMIOS term;
+ int r;
+
+ if (IsDefaultFd (fd))
+ {
+ fdState.array[fd].IsRaw = FALSE;
+ }
+ term = termios_InitTermios ();
+ if ((termios_tcgetattr (fd, term)) == 0)
+ {
+ dononraw (term);
+ if (input)
+ {
+ r = termios_tcsetattr (fd, termios_tcsflush (), term);
+ }
+ else
+ {
+ r = termios_tcsetattr (fd, termios_tcsdrain (), term);
+ }
+ }
+ term = termios_KillTermios (term);
+}
+
+
+/*
+ EchoOn - turns on echoing for file descriptor, fd. This
+ only really makes sence for a file descriptor opened
+ for terminal input or maybe some specific file descriptor
+ which is attached to a particular piece of hardware.
+*/
+
+extern "C" void IO_EchoOn (int fd, unsigned int input)
+{
+ termios_TERMIOS term;
+ int result;
+
+ term = termios_InitTermios ();
+ if ((termios_tcgetattr (fd, term)) == 0)
+ {
+ setFlag (term, termios_lecho, TRUE);
+ if (input)
+ {
+ result = termios_tcsetattr (fd, termios_tcsflush (), term);
+ }
+ else
+ {
+ result = termios_tcsetattr (fd, termios_tcsdrain (), term);
+ }
+ }
+ term = termios_KillTermios (term);
+}
+
+
+/*
+ EchoOff - turns off echoing for file descriptor, fd. This
+ only really makes sence for a file descriptor opened
+ for terminal input or maybe some specific file descriptor
+ which is attached to a particular piece of hardware.
+*/
+
+extern "C" void IO_EchoOff (int fd, unsigned int input)
+{
+ termios_TERMIOS term;
+ int result;
+
+ term = termios_InitTermios ();
+ if ((termios_tcgetattr (fd, term)) == 0)
+ {
+ setFlag (term, termios_lecho, FALSE);
+ if (input)
+ {
+ result = termios_tcsetattr (fd, termios_tcsflush (), term);
+ }
+ else
+ {
+ result = termios_tcsetattr (fd, termios_tcsdrain (), term);
+ }
+ }
+ term = termios_KillTermios (term);
+}
+
+extern "C" void _M2_IO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Init ();
+}
+
+extern "C" void _M2_IO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GIndexing.cc b/gcc/m2/mc-boot/GIndexing.cc
new file mode 100644
index 00000000000..0817ff36ca2
--- /dev/null
+++ b/gcc/m2/mc-boot/GIndexing.cc
@@ -0,0 +1,491 @@
+/* do not edit automatically generated by mc from Indexing. */
+/* Indexing provides a dynamic array of pointers.
+ Copyright (C) 2015-2023 Free Software Foundation, Inc.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _Indexing_H
+#define _Indexing_C
+
+# include "Glibc.h"
+# include "GStorage.h"
+# include "GSYSTEM.h"
+# include "GmcDebug.h"
+# include "GM2RTS.h"
+
+typedef struct Indexing_IndexProcedure_p Indexing_IndexProcedure;
+
+# define MinSize 128
+typedef struct Indexing__T2_r Indexing__T2;
+
+typedef void * *Indexing_PtrToAddress;
+
+typedef Indexing__T2 *Indexing_Index;
+
+typedef unsigned char *Indexing_PtrToByte;
+
+typedef void (*Indexing_IndexProcedure_t) (void *);
+struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; };
+
+struct Indexing__T2_r {
+ void *ArrayStart;
+ unsigned int ArraySize;
+ unsigned int Used;
+ unsigned int Low;
+ unsigned int High;
+ unsigned int Debug;
+ unsigned int Map;
+ };
+
+
+/*
+ InitIndex - creates and returns an Index.
+*/
+
+extern "C" Indexing_Index Indexing_InitIndex (unsigned int low);
+
+/*
+ KillIndex - returns Index to free storage.
+*/
+
+extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i);
+
+/*
+ DebugIndex - turns on debugging within an index.
+*/
+
+extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i);
+
+/*
+ InBounds - returns TRUE if indice, n, is within the bounds
+ of the dynamic array.
+*/
+
+extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n);
+
+/*
+ HighIndice - returns the last legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_HighIndice (Indexing_Index i);
+
+/*
+ LowIndice - returns the first legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_LowIndice (Indexing_Index i);
+
+/*
+ PutIndice - places, a, into the dynamic array at position i[n]
+*/
+
+extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a);
+
+/*
+ GetIndice - retrieves, element i[n] from the dynamic array.
+*/
+
+extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n);
+
+/*
+ IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*/
+
+extern "C" unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a);
+
+/*
+ RemoveIndiceFromIndex - removes, a, from Index, i.
+*/
+
+extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a);
+
+/*
+ DeleteIndice - delete i[j] from the array.
+*/
+
+extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j);
+
+/*
+ IncludeIndiceIntoIndex - if the indice is not in the index, then
+ add it at the end.
+*/
+
+extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a);
+
+/*
+ ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*/
+
+extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p);
+
+
+/*
+ InitIndex - creates and returns an Index.
+*/
+
+extern "C" Indexing_Index Indexing_InitIndex (unsigned int low)
+{
+ Indexing_Index i;
+
+ Storage_ALLOCATE ((void **) &i, sizeof (Indexing__T2));
+ i->Low = low;
+ i->High = 0;
+ i->ArraySize = MinSize;
+ Storage_ALLOCATE (&i->ArrayStart, MinSize);
+ i->ArrayStart = libc_memset (i->ArrayStart, 0, static_cast<size_t> (i->ArraySize));
+ i->Debug = FALSE;
+ i->Used = 0;
+ i->Map = (unsigned int) 0;
+ return i;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillIndex - returns Index to free storage.
+*/
+
+extern "C" Indexing_Index Indexing_KillIndex (Indexing_Index i)
+{
+ Storage_DEALLOCATE (&i->ArrayStart, i->ArraySize);
+ Storage_DEALLOCATE ((void **) &i, sizeof (Indexing__T2));
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DebugIndex - turns on debugging within an index.
+*/
+
+extern "C" Indexing_Index Indexing_DebugIndex (Indexing_Index i)
+{
+ i->Debug = TRUE;
+ return i;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InBounds - returns TRUE if indice, n, is within the bounds
+ of the dynamic array.
+*/
+
+extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n)
+{
+ if (i == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return (n >= i->Low) && (n <= i->High);
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ HighIndice - returns the last legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_HighIndice (Indexing_Index i)
+{
+ if (i == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return i->High;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ LowIndice - returns the first legally accessible indice of this array.
+*/
+
+extern "C" unsigned int Indexing_LowIndice (Indexing_Index i)
+{
+ if (i == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ return i->Low;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ PutIndice - places, a, into the dynamic array at position i[n]
+*/
+
+extern "C" void Indexing_PutIndice (Indexing_Index i, unsigned int n, void * a)
+{
+ typedef unsigned int * *PutIndice__T1;
+
+ unsigned int oldSize;
+ void * b;
+ PutIndice__T1 p;
+
+ if (! (Indexing_InBounds (i, n)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (n < i->Low)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ oldSize = i->ArraySize;
+ while (((n-i->Low)*sizeof (void *)) >= i->ArraySize)
+ {
+ i->ArraySize = i->ArraySize*2;
+ }
+ if (oldSize != i->ArraySize)
+ {
+ /*
+ IF Debug
+ THEN
+ printf2('increasing memory hunk from %d to %d
+ ',
+ oldSize, ArraySize)
+ END ;
+ */
+ Storage_REALLOCATE (&i->ArrayStart, i->ArraySize);
+ /* and initialize the remainder of the array to NIL */
+ b = i->ArrayStart;
+ b = reinterpret_cast<void *> (reinterpret_cast<char *> (b)+oldSize);
+ b = libc_memset (b, 0, static_cast<size_t> (i->ArraySize-oldSize));
+ }
+ i->High = n;
+ }
+ }
+ b = i->ArrayStart;
+ b = reinterpret_cast<void *> (reinterpret_cast<char *> (b)+(n-i->Low)*sizeof (void *));
+ p = static_cast<PutIndice__T1> (b);
+ (*p) = reinterpret_cast<unsigned int *> (a);
+ i->Used += 1;
+ if (i->Debug)
+ {
+ if (n < 32)
+ {
+ i->Map |= (1 << (n ));
+ }
+ }
+}
+
+
+/*
+ GetIndice - retrieves, element i[n] from the dynamic array.
+*/
+
+extern "C" void * Indexing_GetIndice (Indexing_Index i, unsigned int n)
+{
+ Indexing_PtrToByte b;
+ Indexing_PtrToAddress p;
+
+ if (! (Indexing_InBounds (i, n)))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ b = static_cast<Indexing_PtrToByte> (i->ArrayStart);
+ b += (n-i->Low)*sizeof (void *);
+ p = (Indexing_PtrToAddress) (b);
+ if (i->Debug)
+ {
+ if (((n < 32) && (! ((((1 << (n)) & (i->Map)) != 0)))) && ((*p) != NULL))
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ }
+ return (*p);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsIndiceInIndex - returns TRUE if, a, is in the index, i.
+*/
+
+extern "C" unsigned int Indexing_IsIndiceInIndex (Indexing_Index i, void * a)
+{
+ unsigned int j;
+ Indexing_PtrToByte b;
+ Indexing_PtrToAddress p;
+
+ j = i->Low;
+ b = static_cast<Indexing_PtrToByte> (i->ArrayStart);
+ while (j <= i->High)
+ {
+ p = (Indexing_PtrToAddress) (b);
+ if ((*p) == a)
+ {
+ return TRUE;
+ }
+ /* we must not INC(p, ..) as p2c gets confused */
+ b += sizeof (void *);
+ j += 1;
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ RemoveIndiceFromIndex - removes, a, from Index, i.
+*/
+
+extern "C" void Indexing_RemoveIndiceFromIndex (Indexing_Index i, void * a)
+{
+ unsigned int j;
+ unsigned int k;
+ Indexing_PtrToAddress p;
+ Indexing_PtrToByte b;
+
+ j = i->Low;
+ b = static_cast<Indexing_PtrToByte> (i->ArrayStart);
+ while (j <= i->High)
+ {
+ p = (Indexing_PtrToAddress) (b);
+ b += sizeof (void *);
+ if ((*p) == a)
+ {
+ Indexing_DeleteIndice (i, j);
+ }
+ j += 1;
+ }
+}
+
+
+/*
+ DeleteIndice - delete i[j] from the array.
+*/
+
+extern "C" void Indexing_DeleteIndice (Indexing_Index i, unsigned int j)
+{
+ Indexing_PtrToAddress p;
+ Indexing_PtrToByte b;
+
+ if (Indexing_InBounds (i, j))
+ {
+ b = static_cast<Indexing_PtrToByte> (i->ArrayStart);
+ b += sizeof (void *)*(j-i->Low);
+ p = (Indexing_PtrToAddress) (b);
+ b += sizeof (void *);
+ p = static_cast<Indexing_PtrToAddress> (libc_memmove (reinterpret_cast<void *> (p), reinterpret_cast<void *> (b), static_cast<size_t> ((i->High-j)*sizeof (void *))));
+ i->High -= 1;
+ i->Used -= 1;
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ IncludeIndiceIntoIndex - if the indice is not in the index, then
+ add it at the end.
+*/
+
+extern "C" void Indexing_IncludeIndiceIntoIndex (Indexing_Index i, void * a)
+{
+ if (! (Indexing_IsIndiceInIndex (i, a)))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (i->Used == 0)
+ {
+ Indexing_PutIndice (i, Indexing_LowIndice (i), a);
+ }
+ else
+ {
+ Indexing_PutIndice (i, (Indexing_HighIndice (i))+1, a);
+ }
+ }
+}
+
+
+/*
+ ForeachIndiceInIndexDo - for each j indice of i, call procedure p(i[j])
+*/
+
+extern "C" void Indexing_ForeachIndiceInIndexDo (Indexing_Index i, Indexing_IndexProcedure p)
+{
+ unsigned int j;
+ Indexing_IndexProcedure q;
+
+ j = Indexing_LowIndice (i);
+ q = p;
+ while (j <= (Indexing_HighIndice (i)))
+ {
+ mcDebug_assert (q.proc == p.proc);
+ (*p.proc) (Indexing_GetIndice (i, j));
+ j += 1;
+ }
+}
+
+extern "C" void _M2_Indexing_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Indexing_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GM2Dependent.cc b/gcc/m2/mc-boot/GM2Dependent.cc
new file mode 100644
index 00000000000..64441fff642
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2Dependent.cc
@@ -0,0 +1,1407 @@
+/* do not edit automatically generated by mc from M2Dependent. */
+/* M2Dependent.mod implements the run time module dependencies.
+
+Copyright (C) 2022-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _M2Dependent_H
+#define _M2Dependent_C
+
+# include "Glibc.h"
+# include "GM2LINK.h"
+# include "GASCII.h"
+# include "GSYSTEM.h"
+# include "GStorage.h"
+# include "GStrLib.h"
+# include "GM2RTS.h"
+
+typedef struct M2Dependent_ArgCVEnvP_p M2Dependent_ArgCVEnvP;
+
+typedef struct M2Dependent_DependencyList_r M2Dependent_DependencyList;
+
+typedef struct M2Dependent__T2_r M2Dependent__T2;
+
+typedef M2Dependent__T2 *M2Dependent_ModuleChain;
+
+typedef struct M2Dependent__T3_a M2Dependent__T3;
+
+typedef enum {M2Dependent_unregistered, M2Dependent_unordered, M2Dependent_started, M2Dependent_ordered, M2Dependent_user} M2Dependent_DependencyState;
+
+typedef void (*M2Dependent_ArgCVEnvP_t) (int, void *, void *);
+struct M2Dependent_ArgCVEnvP_p { M2Dependent_ArgCVEnvP_t proc; };
+
+struct M2Dependent_DependencyList_r {
+ PROC proc;
+ unsigned int forced;
+ unsigned int forc;
+ unsigned int appl;
+ M2Dependent_DependencyState state;
+ };
+
+struct M2Dependent__T3_a { M2Dependent_ModuleChain array[M2Dependent_user-M2Dependent_unregistered+1]; };
+struct M2Dependent__T2_r {
+ void *name;
+ void *libname;
+ M2Dependent_ArgCVEnvP init;
+ M2Dependent_ArgCVEnvP fini;
+ M2Dependent_DependencyList dependency;
+ M2Dependent_ModuleChain prev;
+ M2Dependent_ModuleChain next;
+ };
+
+static M2Dependent__T3 Modules;
+static unsigned int Initialized;
+static unsigned int WarningTrace;
+static unsigned int ModuleTrace;
+static unsigned int HexTrace;
+static unsigned int DependencyTrace;
+static unsigned int PreTrace;
+static unsigned int PostTrace;
+static unsigned int ForceTrace;
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule. It only takes effect
+ if we are not using StaticInitialization.
+*/
+
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
+
+/*
+ CreateModule - creates a new module entry and returns the
+ ModuleChain.
+*/
+
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ AppendModule - append chain to end of the list.
+*/
+
+static void AppendModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain);
+
+/*
+ RemoveModule - remove chain from double linked list head.
+*/
+
+static void RemoveModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain);
+
+/*
+ onChain - returns TRUE if mptr is on the Modules[state] list.
+*/
+
+static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr);
+
+/*
+ max -
+*/
+
+static unsigned int max (unsigned int a, unsigned int b);
+
+/*
+ min -
+*/
+
+static unsigned int min (unsigned int a, unsigned int b);
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen);
+
+/*
+ LookupModule - lookup and return the ModuleChain pointer containing
+ module name from a particular list.
+*/
+
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname);
+
+/*
+ toCString - replace any character sequence
+ into a newline.
+*/
+
+static void toCString (char *str, unsigned int _str_high);
+
+/*
+ strcmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b);
+
+/*
+ strncmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n);
+
+/*
+ strlen - returns the length of string.
+*/
+
+static int strlen_ (M2LINK_PtrToChar string);
+
+/*
+ traceprintf - wrap printf with a boolean flag.
+*/
+
+static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high);
+
+/*
+ traceprintf2 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg);
+
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2);
+
+/*
+ moveTo - moves mptr to the new list determined by newstate.
+ It updates the mptr state appropriately.
+*/
+
+static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChain mptr);
+
+/*
+ ResolveDependant -
+*/
+
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname);
+
+/*
+ PerformRequestDependant - the current modulename has a dependancy upon
+ dependantmodule. If dependantmodule is NIL then
+ modulename has no further dependants and it can be
+ resolved.
+*/
+
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
+
+/*
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
+*/
+
+static void ResolveDependencies (void * currentmodule, void * libname);
+
+/*
+ DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high);
+
+/*
+ DumpModuleData -
+*/
+
+static void DumpModuleData (unsigned int flag);
+
+/*
+ combine - dest := src + dest. Places src at the front of list dest.
+ Pre condition: src, dest are lists.
+ Post condition : dest := src + dest
+ src := NIL.
+*/
+
+static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest);
+
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
+/*
+ ForceDependencies - if the user has specified a forced order then we override
+ the dynamic ordering with the preference.
+*/
+
+static void ForceDependencies (void);
+
+/*
+ CheckApplication - check to see that the application is the last entry in the list.
+ This might happen if the application only imports FOR C modules.
+*/
+
+static void CheckApplication (void);
+
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2);
+
+/*
+ equal - return TRUE if C string cstr is equal to str.
+*/
+
+static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high);
+
+/*
+ SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+ DumpPostInit to FALSE. It checks the environment
+ GCC_M2LINK_RTFLAG which can contain
+ "all,module,hex,pre,post,dep,force". all turns them all on.
+ The flag meanings are as follows and flags the are in
+ execution order.
+
+ module generate trace info as the modules are registered.
+ hex dump the modules ctor functions address in hex.
+ pre generate a list of all modules seen prior to having
+ their dependancies resolved.
+ dep display a trace as the modules are resolved.
+ post generate a list of all modules seen after having
+ their dependancies resolved dynamically.
+ force generate a list of all modules seen after having
+ their dependancies resolved and forced.
+*/
+
+static void SetupDebugFlags (void);
+
+/*
+ Init - initialize the debug flags and set all lists to NIL.
+*/
+
+static void Init (void);
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void);
+
+
+/*
+ CreateModule - creates a new module entry and returns the
+ ModuleChain.
+*/
+
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+{
+ M2Dependent_ModuleChain mptr;
+ void * p0;
+ void * p1;
+
+ Storage_ALLOCATE ((void **) &mptr, sizeof (M2Dependent__T2));
+ mptr->name = name;
+ mptr->libname = libname;
+ mptr->init = init;
+ mptr->fini = fini;
+ mptr->dependency.proc = dependencies;
+ mptr->dependency.state = M2Dependent_unregistered;
+ mptr->prev = NULL;
+ mptr->next = NULL;
+ if (HexTrace)
+ {
+ libc_printf ((const char *) " (init: %p fini: %p", 22, init, fini);
+ libc_printf ((const char *) " dep: %p)", 10, dependencies);
+ }
+ return mptr;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ AppendModule - append chain to end of the list.
+*/
+
+static void AppendModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain)
+{
+ if ((*head) == NULL)
+ {
+ (*head) = chain;
+ chain->prev = chain;
+ chain->next = chain;
+ }
+ else
+ {
+ chain->next = (*head); /* Add Item to the end of list. */
+ chain->prev = (*head)->prev; /* Add Item to the end of list. */
+ (*head)->prev->next = chain;
+ (*head)->prev = chain;
+ }
+}
+
+
+/*
+ RemoveModule - remove chain from double linked list head.
+*/
+
+static void RemoveModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain chain)
+{
+ if ((chain->next == (*head)) && (chain == (*head)))
+ {
+ (*head) = NULL;
+ }
+ else
+ {
+ if ((*head) == chain)
+ {
+ (*head) = (*head)->next;
+ }
+ chain->prev->next = chain->next;
+ chain->next->prev = chain->prev;
+ }
+}
+
+
+/*
+ onChain - returns TRUE if mptr is on the Modules[state] list.
+*/
+
+static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr)
+{
+ M2Dependent_ModuleChain ptr;
+
+ if (Modules.array[state-M2Dependent_unregistered] != NULL)
+ {
+ ptr = Modules.array[state-M2Dependent_unregistered];
+ do {
+ if (ptr == mptr)
+ {
+ return TRUE;
+ }
+ ptr = ptr->next;
+ } while (! (ptr == Modules.array[state-M2Dependent_unregistered]));
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ max -
+*/
+
+static unsigned int max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ min -
+*/
+
+static unsigned int min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen)
+{
+ M2Dependent_ModuleChain ptr;
+
+ if (Modules.array[state-M2Dependent_unregistered] != NULL)
+ {
+ ptr = Modules.array[state-M2Dependent_unregistered];
+ do {
+ if (((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), max (namelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->name)))))) == 0) && ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname), reinterpret_cast<M2LINK_PtrToChar> (libname), max (libnamelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname)))))) == 0))
+ {
+ return ptr;
+ }
+ ptr = ptr->next;
+ } while (! (ptr == Modules.array[state-M2Dependent_unregistered]));
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModule - lookup and return the ModuleChain pointer containing
+ module name from a particular list.
+*/
+
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname)
+{
+ return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))), libname, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (libname))));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ toCString - replace any character sequence
+ into a newline.
+*/
+
+static void toCString (char *str, unsigned int _str_high)
+{
+ unsigned int high;
+ unsigned int i;
+ unsigned int j;
+
+ i = 0;
+ high = _str_high;
+ while (i < high)
+ {
+ if ((i < high) && (str[i] == '\\'))
+ {
+ if (str[i+1] == 'n')
+ {
+ str[i] = ASCII_nl;
+ j = i+1;
+ while (j < high)
+ {
+ str[j] = str[j+1];
+ j += 1;
+ }
+ }
+ }
+ i += 1;
+ }
+}
+
+
+/*
+ strcmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b)
+{
+ if ((a != NULL) && (b != NULL))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (a == b)
+ {
+ return 0;
+ }
+ else
+ {
+ while ((*a) == (*b))
+ {
+ if ((*a) == ASCII_nul)
+ {
+ return 0;
+ }
+ a += 1;
+ b += 1;
+ }
+ }
+ }
+ return 1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ strncmp - return 0 if both strings are equal.
+ We cannot use Builtins.def during bootstrap.
+*/
+
+static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n)
+{
+ if (n == 0)
+ {
+ return 0;
+ }
+ else if ((a != NULL) && (b != NULL))
+ {
+ /* avoid dangling else. */
+ if (a == b)
+ {
+ return 0;
+ }
+ else
+ {
+ while (((*a) == (*b)) && (n > 0))
+ {
+ if (((*a) == ASCII_nul) || (n == 1))
+ {
+ return 0;
+ }
+ a += 1;
+ b += 1;
+ n -= 1;
+ }
+ }
+ }
+ return 1;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ strlen - returns the length of string.
+*/
+
+static int strlen_ (M2LINK_PtrToChar string)
+{
+ int count;
+
+ if (string == NULL)
+ {
+ return 0;
+ }
+ else
+ {
+ count = 0;
+ while ((*string) != ASCII_nul)
+ {
+ string += 1;
+ count += 1;
+ }
+ return count;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ traceprintf - wrap printf with a boolean flag.
+*/
+
+static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_high)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ libc_printf ((const char *) str, _str_high);
+ }
+}
+
+
+/*
+ traceprintf2 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg)
+{
+ char ch;
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ if (arg == NULL)
+ {
+ ch = (char) 0;
+ arg = &ch;
+ }
+ libc_printf ((const char *) str, _str_high, arg);
+ }
+}
+
+
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2)
+{
+ char ch;
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ if (arg1 == NULL)
+ {
+ ch = (char) 0;
+ arg1 = &ch;
+ }
+ if (arg2 == NULL)
+ {
+ ch = (char) 0;
+ arg2 = &ch;
+ }
+ libc_printf ((const char *) str, _str_high, arg1, arg2);
+ }
+}
+
+
+/*
+ moveTo - moves mptr to the new list determined by newstate.
+ It updates the mptr state appropriately.
+*/
+
+static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChain mptr)
+{
+ if (onChain (mptr->dependency.state, mptr))
+ {
+ RemoveModule (&Modules.array[mptr->dependency.state-M2Dependent_unregistered], mptr);
+ }
+ mptr->dependency.state = newstate;
+ AppendModule (&Modules.array[mptr->dependency.state-M2Dependent_unregistered], mptr);
+}
+
+
+/*
+ ResolveDependant -
+*/
+
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname)
+{
+ if (mptr == NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not been registered via a global constructor\\n", 68, currentmodule, libname);
+ }
+ else
+ {
+ if (onChain (M2Dependent_started, mptr))
+ {
+ traceprintf (DependencyTrace, (const char *) " processing...\\n", 18);
+ }
+ else
+ {
+ moveTo (M2Dependent_started, mptr);
+ traceprintf3 (DependencyTrace, (const char *) " starting: %s [%s]\\n", 22, currentmodule, libname);
+ (*mptr->dependency.proc.proc) (); /* Invoke and process the dependency graph. */
+ traceprintf3 (DependencyTrace, (const char *) " finished: %s [%s]\\n", 22, currentmodule, libname); /* Invoke and process the dependency graph. */
+ moveTo (M2Dependent_ordered, mptr);
+ }
+ }
+}
+
+
+/*
+ PerformRequestDependant - the current modulename has a dependancy upon
+ dependantmodule. If dependantmodule is NIL then
+ modulename has no further dependants and it can be
+ resolved.
+*/
+
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
+{
+ M2Dependent_ModuleChain mptr;
+
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
+ if (dependantmodule == NULL)
+ {
+ /* avoid dangling else. */
+ traceprintf (DependencyTrace, (const char *) " has finished its import graph\\n", 32);
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
+ if (mptr != NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is now ordered\\n", 33, modulename, libname);
+ moveTo (M2Dependent_ordered, mptr);
+ }
+ }
+ else
+ {
+ traceprintf3 (DependencyTrace, (const char *) " imports from %s [%s]\\n", 23, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_ordered, dependantmodule, dependantlibname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not ordered\\n", 33, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_unordered, dependantmodule, dependantlibname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not unordered\\n", 35, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_started, dependantmodule, dependantlibname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not started\\n", 34, dependantmodule, dependantlibname);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] attempting to import from", 42, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " %s [%s] which has not registered itself via a constructor\\n", 60, dependantmodule, dependantlibname);
+ }
+ else
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has registered itself and has started\\n", 56, dependantmodule, dependantlibname);
+ }
+ }
+ else
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] resolving\\n", 28, dependantmodule, dependantlibname);
+ ResolveDependant (mptr, dependantmodule, dependantlibname);
+ }
+ }
+ else
+ {
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " dependant %s [%s] is ordered\\n", 31, dependantmodule, dependantlibname);
+ }
+ }
+}
+
+
+/*
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
+*/
+
+static void ResolveDependencies (void * currentmodule, void * libname)
+{
+ M2Dependent_ModuleChain mptr;
+
+ mptr = LookupModule (M2Dependent_unordered, currentmodule, libname);
+ while (mptr != NULL)
+ {
+ traceprintf3 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s [%s]\\n", 53, currentmodule, libname);
+ ResolveDependant (mptr, currentmodule, libname);
+ mptr = Modules.array[M2Dependent_unordered-M2Dependent_unregistered];
+ }
+}
+
+
+/*
+ DisplayModuleInfo - displays all module in the state.
+*/
+
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high)
+{
+ M2Dependent_ModuleChain mptr;
+ unsigned int count;
+ char desc[_desc_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (desc, desc_, _desc_high+1);
+
+ if (Modules.array[state-M2Dependent_unregistered] != NULL)
+ {
+ libc_printf ((const char *) "%s modules\\n", 12, &desc);
+ mptr = Modules.array[state-M2Dependent_unregistered];
+ count = 0;
+ do {
+ if (mptr->name == NULL)
+ {
+ libc_printf ((const char *) " %d %s []", 11, count, mptr->name);
+ }
+ else
+ {
+ libc_printf ((const char *) " %d %s [%s]", 13, count, mptr->name, mptr->libname);
+ }
+ count += 1;
+ if (mptr->dependency.appl)
+ {
+ libc_printf ((const char *) " application", 12);
+ }
+ if (mptr->dependency.forc)
+ {
+ libc_printf ((const char *) " for C", 6);
+ }
+ if (mptr->dependency.forced)
+ {
+ libc_printf ((const char *) " forced ordering", 16);
+ }
+ libc_printf ((const char *) "\\n", 2);
+ mptr = mptr->next;
+ } while (! (mptr == Modules.array[state-M2Dependent_unregistered]));
+ }
+}
+
+
+/*
+ DumpModuleData -
+*/
+
+static void DumpModuleData (unsigned int flag)
+{
+ M2Dependent_ModuleChain mptr;
+
+ if (flag)
+ {
+ DisplayModuleInfo (M2Dependent_unregistered, (const char *) "unregistered", 12);
+ DisplayModuleInfo (M2Dependent_unordered, (const char *) "unordered", 9);
+ DisplayModuleInfo (M2Dependent_started, (const char *) "started", 7);
+ DisplayModuleInfo (M2Dependent_ordered, (const char *) "ordered", 7);
+ }
+}
+
+
+/*
+ combine - dest := src + dest. Places src at the front of list dest.
+ Pre condition: src, dest are lists.
+ Post condition : dest := src + dest
+ src := NIL.
+*/
+
+static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest)
+{
+ M2Dependent_ModuleChain last;
+
+ while (Modules.array[src-M2Dependent_unregistered] != NULL)
+ {
+ last = Modules.array[src-M2Dependent_unregistered]->prev;
+ moveTo (M2Dependent_ordered, last);
+ Modules.array[dest-M2Dependent_unregistered] = last; /* New item is at the head. */
+ }
+}
+
+
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ typedef struct tracemodule__T4_a tracemodule__T4;
+
+ struct tracemodule__T4_a { char array[100+1]; };
+ tracemodule__T4 buffer;
+ unsigned int len;
+
+ if (flag)
+ {
+ len = min (modlen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, modname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) "%s ", 3, &buffer);
+ len = min (liblen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, libname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) " [%s]", 5, &buffer);
+ }
+}
+
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ M2Dependent_ModuleChain mptr;
+
+ traceprintf (ForceTrace, (const char *) "forcing module: ", 16);
+ tracemodule (ForceTrace, modname, modlen, libname, liblen);
+ traceprintf (ForceTrace, (const char *) "\\n", 2);
+ mptr = LookupModuleN (M2Dependent_ordered, modname, modlen, libname, liblen);
+ if (mptr != NULL)
+ {
+ mptr->dependency.forced = TRUE;
+ moveTo (M2Dependent_user, mptr);
+ }
+}
+
+
+/*
+ ForceDependencies - if the user has specified a forced order then we override
+ the dynamic ordering with the preference.
+*/
+
+static void ForceDependencies (void)
+{
+ unsigned int len;
+ unsigned int modlen;
+ unsigned int liblen;
+ M2LINK_PtrToChar modname;
+ M2LINK_PtrToChar libname;
+ M2LINK_PtrToChar pc;
+ M2LINK_PtrToChar start;
+
+ if (M2LINK_ForcedModuleInitOrder != NULL)
+ {
+ traceprintf2 (ForceTrace, (const char *) "user forcing order: %s\\n", 24, reinterpret_cast<void *> (M2LINK_ForcedModuleInitOrder));
+ pc = M2LINK_ForcedModuleInitOrder;
+ start = pc;
+ len = 0;
+ modname = NULL;
+ modlen = 0;
+ libname = NULL;
+ liblen = 0;
+ while ((*pc) != ASCII_nul)
+ {
+ switch ((*pc))
+ {
+ case ':':
+ libname = start;
+ liblen = len;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+ case ',':
+ modname = start;
+ modlen = len;
+ ForceModule (reinterpret_cast<void *> (modname), modlen, reinterpret_cast<void *> (libname), liblen);
+ libname = NULL;
+ liblen = 0;
+ modlen = 0;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+
+ default:
+ pc += 1;
+ len += 1;
+ break;
+ }
+ }
+ if (start != pc)
+ {
+ ForceModule (reinterpret_cast<void *> (start), len, reinterpret_cast<void *> (libname), liblen);
+ }
+ combine (M2Dependent_user, M2Dependent_ordered);
+ }
+}
+
+
+/*
+ CheckApplication - check to see that the application is the last entry in the list.
+ This might happen if the application only imports FOR C modules.
+*/
+
+static void CheckApplication (void)
+{
+ M2Dependent_ModuleChain mptr;
+ M2Dependent_ModuleChain appl;
+
+ mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered];
+ if (mptr != NULL)
+ {
+ appl = NULL;
+ do {
+ if (mptr->dependency.appl)
+ {
+ appl = mptr;
+ }
+ else
+ {
+ mptr = mptr->next;
+ }
+ } while (! ((appl != NULL) || (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered])));
+ if (appl != NULL)
+ {
+ RemoveModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
+ AppendModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
+ }
+ }
+}
+
+
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2)
+{
+ typedef struct warning3__T5_a warning3__T5;
+
+ struct warning3__T5_a { char array[4096+1]; };
+ warning3__T5 buffer;
+ int len;
+ char format[_format_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (format, format_, _format_high+1);
+
+ if (WarningTrace)
+ {
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) "warning: ", 9);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) format, _format_high, arg1, arg2);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ }
+}
+
+
+/*
+ equal - return TRUE if C string cstr is equal to str.
+*/
+
+static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high)
+{
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ return (strncmp (reinterpret_cast<M2LINK_PtrToChar> (cstr), reinterpret_cast<M2LINK_PtrToChar> (&str), StrLib_StrLen ((const char *) str, _str_high))) == 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
+ DumpPostInit to FALSE. It checks the environment
+ GCC_M2LINK_RTFLAG which can contain
+ "all,module,hex,pre,post,dep,force". all turns them all on.
+ The flag meanings are as follows and flags the are in
+ execution order.
+
+ module generate trace info as the modules are registered.
+ hex dump the modules ctor functions address in hex.
+ pre generate a list of all modules seen prior to having
+ their dependancies resolved.
+ dep display a trace as the modules are resolved.
+ post generate a list of all modules seen after having
+ their dependancies resolved dynamically.
+ force generate a list of all modules seen after having
+ their dependancies resolved and forced.
+*/
+
+static void SetupDebugFlags (void)
+{
+ typedef char *SetupDebugFlags__T1;
+
+ SetupDebugFlags__T1 pc;
+
+ ModuleTrace = FALSE;
+ DependencyTrace = FALSE;
+ PostTrace = FALSE;
+ PreTrace = FALSE;
+ ForceTrace = FALSE;
+ HexTrace = FALSE;
+ WarningTrace = FALSE;
+ pc = static_cast<SetupDebugFlags__T1> (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("GCC_M2LINK_RTFLAG"))));
+ while ((pc != NULL) && ((*pc) != ASCII_nul))
+ {
+ if (equal (reinterpret_cast<void *> (pc), (const char *) "all", 3))
+ {
+ ModuleTrace = TRUE;
+ DependencyTrace = TRUE;
+ PreTrace = TRUE;
+ PostTrace = TRUE;
+ ForceTrace = TRUE;
+ HexTrace = TRUE;
+ WarningTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "module", 6))
+ {
+ /* avoid dangling else. */
+ ModuleTrace = TRUE;
+ pc += 6;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "warning", 7))
+ {
+ /* avoid dangling else. */
+ WarningTrace = TRUE;
+ pc += 7;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "hex", 3))
+ {
+ /* avoid dangling else. */
+ HexTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "dep", 3))
+ {
+ /* avoid dangling else. */
+ DependencyTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "pre", 3))
+ {
+ /* avoid dangling else. */
+ PreTrace = TRUE;
+ pc += 3;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "post", 4))
+ {
+ /* avoid dangling else. */
+ PostTrace = TRUE;
+ pc += 4;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "force", 5))
+ {
+ /* avoid dangling else. */
+ ForceTrace = TRUE;
+ pc += 5;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ pc += 1;
+ }
+ }
+}
+
+
+/*
+ Init - initialize the debug flags and set all lists to NIL.
+*/
+
+static void Init (void)
+{
+ M2Dependent_DependencyState state;
+
+ SetupDebugFlags ();
+ for (state=M2Dependent_unregistered; state<=M2Dependent_user; state= static_cast<M2Dependent_DependencyState>(static_cast<int>(state+1)))
+ {
+ Modules.array[state-M2Dependent_unregistered] = NULL;
+ }
+}
+
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void)
+{
+ if (! Initialized)
+ {
+ Initialized = TRUE;
+ Init ();
+ }
+}
+
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
+{
+ M2Dependent_ModuleChain mptr;
+ M2Dependent_ArgCVEnvP nulp;
+
+ CheckInitialized ();
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, applicationmodule, libname);
+ mptr = LookupModule (M2Dependent_unordered, applicationmodule, libname);
+ if (mptr != NULL)
+ {
+ mptr->dependency.appl = TRUE;
+ }
+ traceprintf (PreTrace, (const char *) "Pre resolving dependents\\n", 26);
+ DumpModuleData (PreTrace);
+ ResolveDependencies (applicationmodule, libname);
+ traceprintf (PreTrace, (const char *) "Post resolving dependents\\n", 27);
+ DumpModuleData (PostTrace);
+ ForceDependencies ();
+ traceprintf (ForceTrace, (const char *) "After user forcing ordering\\n", 29);
+ DumpModuleData (ForceTrace);
+ CheckApplication ();
+ traceprintf (ForceTrace, (const char *) "After runtime forces application to the end\\n", 45);
+ DumpModuleData (ForceTrace);
+ if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
+ {
+ traceprintf3 (ModuleTrace, (const char *) " module: %s [%s] has not registered itself using a global constructor\\n", 72, applicationmodule, libname);
+ traceprintf2 (ModuleTrace, (const char *) " hint try compile and linking using: gm2 %s.mod\\n", 50, applicationmodule);
+ traceprintf2 (ModuleTrace, (const char *) " or try using: gm2 -fscaffold-static %s.mod\\n", 46, applicationmodule);
+ }
+ else
+ {
+ mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered];
+ do {
+ if (mptr->dependency.forc)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s] for C\\n", 36, mptr->name, mptr->libname);
+ }
+ else
+ {
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s]\\n", 30, mptr->name, mptr->libname);
+ }
+ if (mptr->dependency.appl)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, mptr->name, mptr->libname);
+ traceprintf (ModuleTrace, (const char *) " calling M2RTS_ExecuteInitialProcedures\\n", 42);
+ M2RTS_ExecuteInitialProcedures ();
+ traceprintf (ModuleTrace, (const char *) " calling application module\\n", 30);
+ }
+ (*mptr->init.proc) (argc, argv, envp);
+ mptr = mptr->next;
+ } while (! (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered]));
+ }
+}
+
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
+{
+ M2Dependent_ModuleChain mptr;
+
+ traceprintf3 (ModuleTrace, (const char *) "application module finishing: %s [%s]\\n", 39, applicationmodule, libname);
+ if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
+ {
+ traceprintf (ModuleTrace, (const char *) " no ordered modules found during finishing\\n", 45);
+ }
+ else
+ {
+ traceprintf (ModuleTrace, (const char *) "ExecuteTerminationProcedures\\n", 30);
+ M2RTS_ExecuteTerminationProcedures ();
+ traceprintf (ModuleTrace, (const char *) "terminating modules in sequence\\n", 33);
+ mptr = Modules.array[M2Dependent_ordered-M2Dependent_unregistered]->prev;
+ do {
+ if (mptr->dependency.forc)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s] for C\\n", 34, mptr->name, mptr->libname);
+ }
+ else
+ {
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s]\\n", 28, mptr->name, mptr->libname);
+ }
+ (*mptr->fini.proc) (argc, argv, envp);
+ mptr = mptr->prev;
+ } while (! (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered]->prev));
+ }
+}
+
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+{
+ M2Dependent_ModuleChain mptr;
+
+ CheckInitialized ();
+ if (! M2LINK_StaticInitialization)
+ {
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "module: %s [%s] registering", 27, modulename, libname);
+ moveTo (M2Dependent_unordered, CreateModule (modulename, libname, init, fini, dependencies));
+ traceprintf (ModuleTrace, (const char *) "\\n", 2);
+ }
+ else
+ {
+ warning3 ((const char *) "module: %s [%s] (ignoring duplicate registration)\\n", 51, modulename, libname);
+ }
+ }
+}
+
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule. It only takes effect
+ if we are not using StaticInitialization.
+*/
+
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
+{
+ CheckInitialized ();
+ if (! M2LINK_StaticInitialization)
+ {
+ PerformRequestDependant (modulename, libname, dependantmodule, dependantlibname);
+ }
+}
+
+extern "C" void _M2_M2Dependent_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ CheckInitialized ();
+}
+
+extern "C" void _M2_M2Dependent_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GM2EXCEPTION.cc b/gcc/m2/mc-boot/GM2EXCEPTION.cc
new file mode 100644
index 00000000000..387b0476462
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2EXCEPTION.cc
@@ -0,0 +1,89 @@
+/* do not edit automatically generated by mc from M2EXCEPTION. */
+/* M2EXCEPTION.mod implement M2Exception and IsM2Exception.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# include "Gmcrts.h"
+#define _M2EXCEPTION_H
+#define _M2EXCEPTION_C
+
+# include "GSYSTEM.h"
+# include "GRTExceptions.h"
+
+typedef enum {M2EXCEPTION_indexException, M2EXCEPTION_rangeException, M2EXCEPTION_caseSelectException, M2EXCEPTION_invalidLocation, M2EXCEPTION_functionException, M2EXCEPTION_wholeValueException, M2EXCEPTION_wholeDivException, M2EXCEPTION_realValueException, M2EXCEPTION_realDivException, M2EXCEPTION_complexValueException, M2EXCEPTION_complexDivException, M2EXCEPTION_protException, M2EXCEPTION_sysException, M2EXCEPTION_coException, M2EXCEPTION_exException} M2EXCEPTION_M2Exceptions;
+
+extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void);
+extern "C" unsigned int M2EXCEPTION_IsM2Exception (void);
+
+extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void)
+{
+ RTExceptions_EHBlock e;
+ unsigned int n;
+
+ /* If the program or coroutine is in the exception state then return the enumeration
+ value representing the exception cause. If it is not in the exception state then
+ raises and exception (exException). */
+ e = RTExceptions_GetExceptionBlock ();
+ n = RTExceptions_GetNumber (e);
+ if (n == (UINT_MAX))
+ {
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast<void*> (reinterpret_cast<const void*>("M2Exception")), const_cast<void*> (reinterpret_cast<const void*>("current coroutine is not in the exceptional execution state")));
+ }
+ else
+ {
+ return (M2EXCEPTION_M2Exceptions) (n);
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+extern "C" unsigned int M2EXCEPTION_IsM2Exception (void)
+{
+ RTExceptions_EHBlock e;
+
+ /* Returns TRUE if the program or coroutine is in the exception state.
+ Returns FALSE if the program or coroutine is not in the exception state. */
+ e = RTExceptions_GetExceptionBlock ();
+ return (RTExceptions_GetNumber (e)) != (UINT_MAX);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_M2EXCEPTION_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ RTExceptions_SetExceptionBlock (RTExceptions_InitExceptionBlock ());
+}
+
+extern "C" void _M2_M2EXCEPTION_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GM2RTS.cc b/gcc/m2/mc-boot/GM2RTS.cc
new file mode 100644
index 00000000000..2e8680ccb96
--- /dev/null
+++ b/gcc/m2/mc-boot/GM2RTS.cc
@@ -0,0 +1,819 @@
+/* do not edit automatically generated by mc from M2RTS. */
+/* M2RTS.mod Implements the run time system facilities of Modula-2.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _M2RTS_H
+#define _M2RTS_C
+
+# include "Glibc.h"
+# include "GNumberIO.h"
+# include "GStrLib.h"
+# include "GSYSTEM.h"
+# include "GASCII.h"
+# include "GStorage.h"
+# include "GRTExceptions.h"
+# include "GM2EXCEPTION.h"
+# include "GM2Dependent.h"
+
+typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP;
+
+# define stderrFd 2
+typedef struct M2RTS_ProcedureList_r M2RTS_ProcedureList;
+
+typedef char *M2RTS_PtrToChar;
+
+typedef struct M2RTS__T1_r M2RTS__T1;
+
+typedef M2RTS__T1 *M2RTS_ProcedureChain;
+
+typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *);
+struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; };
+
+struct M2RTS_ProcedureList_r {
+ M2RTS_ProcedureChain head;
+ M2RTS_ProcedureChain tail;
+ };
+
+struct M2RTS__T1_r {
+ PROC p;
+ M2RTS_ProcedureChain prev;
+ M2RTS_ProcedureChain next;
+ };
+
+static M2RTS_ProcedureList InitialProc;
+static M2RTS_ProcedureList TerminateProc;
+static int ExitValue;
+static unsigned int isHalting;
+static unsigned int CallExit;
+static unsigned int Initialized;
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*/
+
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
+
+/*
+ InstallTerminationProcedure - installs a procedure, p, which will
+ be called when the procedure
+ ExecuteTerminationProcedures
+ is invoked. It returns TRUE if the
+ procedure is installed.
+*/
+
+extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p);
+
+/*
+ ExecuteInitialProcedures - executes the initial procedures installed by
+ InstallInitialProcedure.
+*/
+
+extern "C" void M2RTS_ExecuteInitialProcedures (void);
+
+/*
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
+*/
+
+extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p);
+
+/*
+ ExecuteTerminationProcedures - calls each installed termination procedure
+ in reverse order.
+*/
+
+extern "C" void M2RTS_ExecuteTerminationProcedures (void);
+
+/*
+ Terminate - provides compatibility for pim. It calls exit with
+ the exitcode provided in a prior call to ExitOnHalt
+ (or zero if ExitOnHalt was never called). It does
+ not call ExecuteTerminationProcedures.
+*/
+
+extern "C" void M2RTS_Terminate (void) __attribute__ ((noreturn));
+
+/*
+ HALT - terminate the current program. The procedure
+ ExecuteTerminationProcedures
+ is called before the program is stopped. The parameter
+ exitcode is optional. If the parameter is not supplied
+ HALT will call libc 'abort', otherwise it will exit with
+ the code supplied. Supplying a parameter to HALT has the
+ same effect as calling ExitOnHalt with the same code and
+ then calling HALT with no parameter.
+*/
+
+extern "C" void M2RTS_HALT (int exitcode) __attribute__ ((noreturn));
+
+/*
+ Halt - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __attribute__ ((noreturn));
+
+/*
+ HaltC - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description) __attribute__ ((noreturn));
+
+/*
+ ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*/
+
+extern "C" void M2RTS_ExitOnHalt (int e);
+
+/*
+ ErrorMessage - emits an error message to stderr and then calls exit (1).
+*/
+
+extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high) __attribute__ ((noreturn));
+
+/*
+ Length - returns the length of a string, a. This is called whenever
+ the user calls LENGTH and the parameter cannot be calculated
+ at compile time.
+*/
+
+extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high);
+extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+
+/*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*/
+
+static void ExecuteReverse (M2RTS_ProcedureChain procptr);
+
+/*
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
+*/
+
+static unsigned int AppendProc (M2RTS_ProcedureList *proclist, PROC proc);
+
+/*
+ ErrorString - writes a string to stderr.
+*/
+
+static void ErrorString (const char *a_, unsigned int _a_high);
+
+/*
+ ErrorStringC - writes a string to stderr.
+*/
+
+static void ErrorStringC (void * str);
+
+/*
+ ErrorMessageC - emits an error message to stderr and then calls exit (1).
+*/
+
+static void ErrorMessageC (void * message, void * filename, unsigned int line, void * function) __attribute__ ((noreturn));
+
+/*
+ InitProcList - initialize the head and tail pointers to NIL.
+*/
+
+static void InitProcList (M2RTS_ProcedureList *p);
+
+/*
+ Init - initialize the initial, terminate procedure lists and booleans.
+*/
+
+static void Init (void);
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void);
+
+
+/*
+ ExecuteReverse - execute the procedure associated with procptr
+ and then proceed to try and execute all previous
+ procedures in the chain.
+*/
+
+static void ExecuteReverse (M2RTS_ProcedureChain procptr)
+{
+ while (procptr != NULL)
+ {
+ (*procptr->p.proc) (); /* Invoke the procedure. */
+ procptr = procptr->prev; /* Invoke the procedure. */
+ }
+}
+
+
+/*
+ AppendProc - append proc to the end of the procedure list
+ defined by proclist.
+*/
+
+static unsigned int AppendProc (M2RTS_ProcedureList *proclist, PROC proc)
+{
+ M2RTS_ProcedureChain pdes;
+
+ Storage_ALLOCATE ((void **) &pdes, sizeof (M2RTS__T1));
+ pdes->p = proc;
+ pdes->prev = (*proclist).tail;
+ pdes->next = NULL;
+ if ((*proclist).head == NULL)
+ {
+ (*proclist).head = pdes;
+ }
+ (*proclist).tail = pdes;
+ return TRUE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ErrorString - writes a string to stderr.
+*/
+
+static void ErrorString (const char *a_, unsigned int _a_high)
+{
+ int n;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ n = static_cast<int> (libc_write (stderrFd, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
+}
+
+
+/*
+ ErrorStringC - writes a string to stderr.
+*/
+
+static void ErrorStringC (void * str)
+{
+ int len;
+
+ len = static_cast<int> (libc_write (stderrFd, str, libc_strlen (str)));
+}
+
+
+/*
+ ErrorMessageC - emits an error message to stderr and then calls exit (1).
+*/
+
+static void ErrorMessageC (void * message, void * filename, unsigned int line, void * function)
+{
+ typedef struct ErrorMessageC__T2_a ErrorMessageC__T2;
+
+ struct ErrorMessageC__T2_a { char array[10+1]; };
+ ErrorMessageC__T2 buffer;
+
+ ErrorStringC (filename);
+ ErrorString ((const char *) ":", 1);
+ NumberIO_CardToStr (line, 0, (char *) &buffer.array[0], 10);
+ ErrorString ((const char *) &buffer.array[0], 10);
+ ErrorString ((const char *) ":", 1);
+ if ((libc_strlen (function)) > 0)
+ {
+ ErrorString ((const char *) "in ", 3);
+ ErrorStringC (function);
+ ErrorString ((const char *) " has caused ", 12);
+ }
+ ErrorStringC (message);
+ buffer.array[0] = ASCII_nl;
+ buffer.array[1] = ASCII_nul;
+ ErrorString ((const char *) &buffer.array[0], 10);
+ libc_exit (1);
+}
+
+
+/*
+ InitProcList - initialize the head and tail pointers to NIL.
+*/
+
+static void InitProcList (M2RTS_ProcedureList *p)
+{
+ (*p).head = NULL;
+ (*p).tail = NULL;
+}
+
+
+/*
+ Init - initialize the initial, terminate procedure lists and booleans.
+*/
+
+static void Init (void)
+{
+ InitProcList (&InitialProc);
+ InitProcList (&TerminateProc);
+ ExitValue = 0;
+ isHalting = FALSE;
+ CallExit = FALSE; /* default by calling abort */
+}
+
+
+/*
+ CheckInitialized - checks to see if this module has been initialized
+ and if it has not it calls Init. We need this
+ approach as this module is called by module ctors
+ before we reach main.
+*/
+
+static void CheckInitialized (void)
+{
+ if (! Initialized)
+ {
+ Initialized = TRUE;
+ Init ();
+ }
+}
+
+
+/*
+ ConstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
+{
+ M2Dependent_ConstructModules (applicationmodule, libname, argc, argv, envp);
+}
+
+
+/*
+ DeconstructModules - resolve dependencies and then call each
+ module constructor in turn.
+*/
+
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
+{
+ M2Dependent_DeconstructModules (applicationmodule, libname, argc, argv, envp);
+}
+
+
+/*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*/
+
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
+{
+ M2Dependent_RegisterModule (name, libname, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) init.proc}, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) fini.proc}, dependencies);
+}
+
+
+/*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*/
+
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
+{
+ M2Dependent_RequestDependant (modulename, libname, dependantmodule, dependantlibname);
+}
+
+
+/*
+ InstallTerminationProcedure - installs a procedure, p, which will
+ be called when the procedure
+ ExecuteTerminationProcedures
+ is invoked. It returns TRUE if the
+ procedure is installed.
+*/
+
+extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p)
+{
+ return AppendProc (&TerminateProc, p);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ExecuteInitialProcedures - executes the initial procedures installed by
+ InstallInitialProcedure.
+*/
+
+extern "C" void M2RTS_ExecuteInitialProcedures (void)
+{
+ ExecuteReverse (InitialProc.tail);
+}
+
+
+/*
+ InstallInitialProcedure - installs a procedure to be executed just
+ before the BEGIN code section of the
+ main program module.
+*/
+
+extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p)
+{
+ return AppendProc (&InitialProc, p);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ExecuteTerminationProcedures - calls each installed termination procedure
+ in reverse order.
+*/
+
+extern "C" void M2RTS_ExecuteTerminationProcedures (void)
+{
+ ExecuteReverse (TerminateProc.tail);
+}
+
+
+/*
+ Terminate - provides compatibility for pim. It calls exit with
+ the exitcode provided in a prior call to ExitOnHalt
+ (or zero if ExitOnHalt was never called). It does
+ not call ExecuteTerminationProcedures.
+*/
+
+extern "C" void M2RTS_Terminate (void)
+{
+ libc_exit (ExitValue);
+}
+
+
+/*
+ HALT - terminate the current program. The procedure
+ ExecuteTerminationProcedures
+ is called before the program is stopped. The parameter
+ exitcode is optional. If the parameter is not supplied
+ HALT will call libc 'abort', otherwise it will exit with
+ the code supplied. Supplying a parameter to HALT has the
+ same effect as calling ExitOnHalt with the same code and
+ then calling HALT with no parameter.
+*/
+
+extern "C" void M2RTS_HALT (int exitcode)
+{
+ if (exitcode != -1)
+ {
+ CallExit = TRUE;
+ ExitValue = exitcode;
+ }
+ if (isHalting)
+ {
+ /* double HALT found */
+ libc_exit (-1);
+ }
+ else
+ {
+ isHalting = TRUE;
+ M2RTS_ExecuteTerminationProcedures ();
+ }
+ if (CallExit)
+ {
+ libc_exit (ExitValue);
+ }
+ else
+ {
+ libc_abort ();
+ }
+}
+
+
+/*
+ Halt - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high)
+{
+ char filename[_filename_high+1];
+ char function[_function_high+1];
+ char description[_description_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (filename, filename_, _filename_high+1);
+ memcpy (function, function_, _function_high+1);
+ memcpy (description, description_, _description_high+1);
+
+ M2RTS_ErrorMessage ((const char *) description, _description_high, (const char *) filename, _filename_high, line, (const char *) function, _function_high);
+}
+
+
+/*
+ HaltC - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description)
+{
+ ErrorMessageC (description, filename, line, function);
+}
+
+
+/*
+ ExitOnHalt - if HALT is executed then call exit with the exit code, e.
+*/
+
+extern "C" void M2RTS_ExitOnHalt (int e)
+{
+ ExitValue = e;
+ CallExit = TRUE;
+}
+
+
+/*
+ ErrorMessage - emits an error message to stderr and then calls exit (1).
+*/
+
+extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high)
+{
+ typedef struct ErrorMessage__T3_a ErrorMessage__T3;
+
+ struct ErrorMessage__T3_a { char array[10+1]; };
+ ErrorMessage__T3 buffer;
+ char message[_message_high+1];
+ char filename[_filename_high+1];
+ char function[_function_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (message, message_, _message_high+1);
+ memcpy (filename, filename_, _filename_high+1);
+ memcpy (function, function_, _function_high+1);
+
+ ErrorString ((const char *) filename, _filename_high);
+ ErrorString ((const char *) ":", 1);
+ NumberIO_CardToStr (line, 0, (char *) &buffer.array[0], 10);
+ ErrorString ((const char *) &buffer.array[0], 10);
+ ErrorString ((const char *) ":", 1);
+ if (! (StrLib_StrEqual ((const char *) function, _function_high, (const char *) "", 0)))
+ {
+ ErrorString ((const char *) "in ", 3);
+ ErrorString ((const char *) function, _function_high);
+ ErrorString ((const char *) " has caused ", 12);
+ }
+ ErrorString ((const char *) message, _message_high);
+ buffer.array[0] = ASCII_nl;
+ buffer.array[1] = ASCII_nul;
+ ErrorString ((const char *) &buffer.array[0], 10);
+ libc_exit (1);
+}
+
+
+/*
+ Length - returns the length of a string, a. This is called whenever
+ the user calls LENGTH and the parameter cannot be calculated
+ at compile time.
+*/
+
+extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high)
+{
+ unsigned int l;
+ unsigned int h;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ l = 0;
+ h = _a_high;
+ while ((l <= h) && (a[l] != ASCII_nul))
+ {
+ l += 1;
+ }
+ return l;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ /*
+ The following are the runtime exception handler routines.
+ */
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), filename, line, column, scope, message);
+}
+
+extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), filename, line, column, scope, message);
+}
+
+extern "C" void _M2_M2RTS_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ CheckInitialized ();
+}
+
+extern "C" void _M2_M2RTS_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GMemUtils.cc b/gcc/m2/mc-boot/GMemUtils.cc
new file mode 100644
index 00000000000..a80e00ecec8
--- /dev/null
+++ b/gcc/m2/mc-boot/GMemUtils.cc
@@ -0,0 +1,126 @@
+/* do not edit automatically generated by mc from MemUtils. */
+/* MemUtils.mod provides some basic memory utilities.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _MemUtils_H
+#define _MemUtils_C
+
+# include "GSYSTEM.h"
+
+
+/*
+ MemCopy - copys a region of memory to the required destination.
+*/
+
+extern "C" void MemUtils_MemCopy (void * from, unsigned int length, void * to);
+
+/*
+ MemZero - sets a region of memory: a..a+length to zero.
+*/
+
+extern "C" void MemUtils_MemZero (void * a, unsigned int length);
+
+
+/*
+ MemCopy - copys a region of memory to the required destination.
+*/
+
+extern "C" void MemUtils_MemCopy (void * from, unsigned int length, void * to)
+{
+ typedef unsigned int *MemCopy__T1;
+
+ typedef unsigned char *MemCopy__T2;
+
+ MemCopy__T1 pwb;
+ MemCopy__T1 pwa;
+ MemCopy__T2 pbb;
+ MemCopy__T2 pba;
+
+ while (length >= sizeof (unsigned int ))
+ {
+ pwa = static_cast<MemCopy__T1> (from);
+ pwb = static_cast<MemCopy__T1> (to);
+ (*pwb) = (*pwa);
+ from = reinterpret_cast<void *> (reinterpret_cast<char *> (from)+sizeof (unsigned int ));
+ to = reinterpret_cast<void *> (reinterpret_cast<char *> (to)+sizeof (unsigned int ));
+ length -= sizeof (unsigned int );
+ }
+ while (length > 0)
+ {
+ pba = static_cast<MemCopy__T2> (from);
+ pbb = static_cast<MemCopy__T2> (to);
+ (*pbb) = (*pba);
+ from = reinterpret_cast<void *> (reinterpret_cast<char *> (from)+sizeof (unsigned char ));
+ to = reinterpret_cast<void *> (reinterpret_cast<char *> (to)+sizeof (unsigned char ));
+ length -= sizeof (unsigned char );
+ }
+}
+
+
+/*
+ MemZero - sets a region of memory: a..a+length to zero.
+*/
+
+extern "C" void MemUtils_MemZero (void * a, unsigned int length)
+{
+ typedef unsigned int *MemZero__T3;
+
+ typedef unsigned char *MemZero__T4;
+
+ MemZero__T3 pwa;
+ MemZero__T4 pba;
+
+ pwa = static_cast<MemZero__T3> (a);
+ while (length >= sizeof (unsigned int ))
+ {
+ (*pwa) = (unsigned int ) (0);
+ pwa += sizeof (unsigned int );
+ length -= sizeof (unsigned int );
+ }
+ pba = static_cast<MemZero__T4> ((void *) (pwa));
+ while (length >= sizeof (unsigned char ))
+ {
+ (*pba) = (unsigned char ) (0);
+ pba += sizeof (unsigned char );
+ length -= sizeof (unsigned char );
+ }
+}
+
+extern "C" void _M2_MemUtils_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_MemUtils_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GNumberIO.cc b/gcc/m2/mc-boot/GNumberIO.cc
new file mode 100644
index 00000000000..53bac45552c
--- /dev/null
+++ b/gcc/m2/mc-boot/GNumberIO.cc
@@ -0,0 +1,776 @@
+/* do not edit automatically generated by mc from NumberIO. */
+/* NumberIO.mod provides conversion of ordinal numbers.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#define _NumberIO_H
+#define _NumberIO_C
+
+# include "GASCII.h"
+# include "GStrIO.h"
+# include "GStrLib.h"
+# include "GM2RTS.h"
+
+# define MaxLineLength 79
+# define MaxDigits 20
+# define MaxHexDigits 20
+# define MaxOctDigits 40
+# define MaxBits 64
+extern "C" void NumberIO_ReadCard (unsigned int *x);
+extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n);
+extern "C" void NumberIO_ReadHex (unsigned int *x);
+extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n);
+extern "C" void NumberIO_ReadInt (int *x);
+extern "C" void NumberIO_WriteInt (int x, unsigned int n);
+extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x);
+extern "C" void NumberIO_ReadOct (unsigned int *x);
+extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n);
+extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_ReadBin (unsigned int *x);
+extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n);
+extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high);
+extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x);
+extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x);
+extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x);
+extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x);
+
+extern "C" void NumberIO_ReadCard (unsigned int *x)
+{
+ typedef struct ReadCard__T1_a ReadCard__T1;
+
+ struct ReadCard__T1_a { char array[MaxLineLength+1]; };
+ ReadCard__T1 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToCard ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteCard (unsigned int x, unsigned int n)
+{
+ typedef struct WriteCard__T2_a WriteCard__T2;
+
+ struct WriteCard__T2_a { char array[MaxLineLength+1]; };
+ WriteCard__T2 a;
+
+ NumberIO_CardToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_ReadHex (unsigned int *x)
+{
+ typedef struct ReadHex__T3_a ReadHex__T3;
+
+ struct ReadHex__T3_a { char array[MaxLineLength+1]; };
+ ReadHex__T3 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToHex ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteHex (unsigned int x, unsigned int n)
+{
+ typedef struct WriteHex__T4_a WriteHex__T4;
+
+ struct WriteHex__T4_a { char array[MaxLineLength+1]; };
+ WriteHex__T4 a;
+
+ NumberIO_HexToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_ReadInt (int *x)
+{
+ typedef struct ReadInt__T5_a ReadInt__T5;
+
+ struct ReadInt__T5_a { char array[MaxLineLength+1]; };
+ ReadInt__T5 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToInt ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteInt (int x, unsigned int n)
+{
+ typedef struct WriteInt__T6_a WriteInt__T6;
+
+ struct WriteInt__T6_a { char array[MaxLineLength+1]; };
+ WriteInt__T6 a;
+
+ NumberIO_IntToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_CardToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct CardToStr__T7_a CardToStr__T7;
+
+ struct CardToStr__T7_a { unsigned int array[MaxDigits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int Higha;
+ CardToStr__T7 buf;
+
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxDigits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = x % 10;
+ x = x / 10;
+ } while (! (x == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = ' ';
+ j += 1;
+ n -= 1;
+ }
+ while ((i > 0) && (j <= Higha))
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToCard (const char *a_, unsigned int _a_high, unsigned int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if ((a[i] < '0') || (a[i] > '9'))
+ {
+ i += 1;
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ (*x) = (10*(*x))+( ((unsigned int) (a[i]))- ((unsigned int) ('0')));
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if ((a[i] < '0') || (a[i] > '9'))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void NumberIO_HexToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct HexToStr__T8_a HexToStr__T8;
+
+ struct HexToStr__T8_a { unsigned int array[MaxHexDigits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int Higha;
+ HexToStr__T8 buf;
+
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxHexDigits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = x % 0x010;
+ x = x / 0x010;
+ } while (! (x == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = '0';
+ j += 1;
+ n -= 1;
+ }
+ while ((i != 0) && (j <= Higha))
+ {
+ if (buf.array[i-1] < 10)
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ }
+ else
+ {
+ a[j] = ((char) ((buf.array[i-1]+ ((unsigned int) ('A')))-10));
+ }
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToHex (const char *a_, unsigned int _a_high, unsigned int *x)
+{
+ int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ NumberIO_StrToHexInt ((const char *) a, _a_high, &i);
+ (*x) = (unsigned int ) (i);
+}
+
+extern "C" void NumberIO_IntToStr (int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct IntToStr__T9_a IntToStr__T9;
+
+ struct IntToStr__T9_a { unsigned int array[MaxDigits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int c;
+ unsigned int Higha;
+ IntToStr__T9 buf;
+ unsigned int Negative;
+
+ if (x < 0)
+ {
+ /* avoid dangling else. */
+ Negative = TRUE;
+ c = ((unsigned int ) (abs (x+1)))+1;
+ if (n > 0)
+ {
+ n -= 1;
+ }
+ }
+ else
+ {
+ c = x;
+ Negative = FALSE;
+ }
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxDigits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = c % 10;
+ c = c / 10;
+ } while (! (c == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = ' ';
+ j += 1;
+ n -= 1;
+ }
+ if (Negative)
+ {
+ a[j] = '-';
+ j += 1;
+ }
+ while ((i != 0) && (j <= Higha))
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToInt (const char *a_, unsigned int _a_high, int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int Negative;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ Negative = FALSE;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if (a[i] == '-')
+ {
+ i += 1;
+ Negative = ! Negative;
+ }
+ else if ((a[i] < '0') || (a[i] > '9'))
+ {
+ /* avoid dangling else. */
+ i += 1;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ if (Negative)
+ {
+ (*x) = (10*(*x))-((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ }
+ else
+ {
+ (*x) = (10*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ }
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if ((a[i] < '0') || (a[i] > '9'))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void NumberIO_ReadOct (unsigned int *x)
+{
+ typedef struct ReadOct__T10_a ReadOct__T10;
+
+ struct ReadOct__T10_a { char array[MaxLineLength+1]; };
+ ReadOct__T10 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToOct ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteOct (unsigned int x, unsigned int n)
+{
+ typedef struct WriteOct__T11_a WriteOct__T11;
+
+ struct WriteOct__T11_a { char array[MaxLineLength+1]; };
+ WriteOct__T11 a;
+
+ NumberIO_OctToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_OctToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct OctToStr__T12_a OctToStr__T12;
+
+ struct OctToStr__T12_a { unsigned int array[MaxOctDigits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int Higha;
+ OctToStr__T12 buf;
+
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxOctDigits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxDigits", 29);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = x % 8;
+ x = x / 8;
+ } while (! (x == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = ' ';
+ j += 1;
+ n -= 1;
+ }
+ while ((i > 0) && (j <= Higha))
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToOct (const char *a_, unsigned int _a_high, unsigned int *x)
+{
+ int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ NumberIO_StrToOctInt ((const char *) a, _a_high, &i);
+ (*x) = (unsigned int ) (i);
+}
+
+extern "C" void NumberIO_ReadBin (unsigned int *x)
+{
+ typedef struct ReadBin__T13_a ReadBin__T13;
+
+ struct ReadBin__T13_a { char array[MaxLineLength+1]; };
+ ReadBin__T13 a;
+
+ StrIO_ReadString ((char *) &a.array[0], MaxLineLength);
+ NumberIO_StrToBin ((const char *) &a.array[0], MaxLineLength, x);
+}
+
+extern "C" void NumberIO_WriteBin (unsigned int x, unsigned int n)
+{
+ typedef struct WriteBin__T14_a WriteBin__T14;
+
+ struct WriteBin__T14_a { char array[MaxLineLength+1]; };
+ WriteBin__T14 a;
+
+ NumberIO_BinToStr (x, n, (char *) &a.array[0], MaxLineLength);
+ StrIO_WriteString ((const char *) &a.array[0], MaxLineLength);
+}
+
+extern "C" void NumberIO_BinToStr (unsigned int x, unsigned int n, char *a, unsigned int _a_high)
+{
+ typedef struct BinToStr__T15_a BinToStr__T15;
+
+ struct BinToStr__T15_a { unsigned int array[MaxBits-1+1]; };
+ unsigned int i;
+ unsigned int j;
+ unsigned int Higha;
+ BinToStr__T15 buf;
+
+ i = 0;
+ do {
+ i += 1;
+ if (i > MaxBits)
+ {
+ StrIO_WriteString ((const char *) "NumberIO - increase MaxBits", 27);
+ StrIO_WriteLn ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ buf.array[i-1] = x % 2;
+ x = x / 2;
+ } while (! (x == 0));
+ j = 0;
+ Higha = _a_high;
+ while ((n > i) && (j <= Higha))
+ {
+ a[j] = ' ';
+ j += 1;
+ n -= 1;
+ }
+ while ((i > 0) && (j <= Higha))
+ {
+ a[j] = ((char) (buf.array[i-1]+ ((unsigned int) ('0'))));
+ j += 1;
+ i -= 1;
+ }
+ if (j <= Higha)
+ {
+ a[j] = ASCII_nul;
+ }
+}
+
+extern "C" void NumberIO_StrToBin (const char *a_, unsigned int _a_high, unsigned int *x)
+{
+ int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ NumberIO_StrToBinInt ((const char *) a, _a_high, &i);
+ (*x) = (unsigned int ) (i);
+}
+
+extern "C" void NumberIO_StrToBinInt (const char *a_, unsigned int _a_high, int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if ((a[i] < '0') || (a[i] > '1'))
+ {
+ i += 1;
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ (*x) = (2*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if ((a[i] < '0') || (a[i] > '1'))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void NumberIO_StrToHexInt (const char *a_, unsigned int _a_high, int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if (((a[i] >= '0') && (a[i] <= '9')) || ((a[i] >= 'A') && (a[i] <= 'F')))
+ {
+ ok = FALSE;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ if ((a[i] >= '0') && (a[i] <= '9'))
+ {
+ (*x) = (0x010*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ }
+ else if ((a[i] >= 'A') && (a[i] <= 'F'))
+ {
+ /* avoid dangling else. */
+ (*x) = (0x010*(*x))+((int ) (( ((unsigned int) (a[i]))- ((unsigned int) ('A')))+10));
+ }
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if (((a[i] < '0') || (a[i] > '9')) && ((a[i] < 'A') || (a[i] > 'F')))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void NumberIO_StrToOctInt (const char *a_, unsigned int _a_high, int *x)
+{
+ unsigned int i;
+ unsigned int ok;
+ unsigned int higha;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StrLib_StrRemoveWhitePrefix ((const char *) a, _a_high, (char *) a, _a_high);
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ i = 0;
+ ok = TRUE;
+ while (ok)
+ {
+ if (i < higha)
+ {
+ if ((a[i] < '0') || (a[i] > '7'))
+ {
+ i += 1;
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ }
+ (*x) = 0;
+ if (i < higha)
+ {
+ ok = TRUE;
+ do {
+ (*x) = (8*(*x))+((int ) ( ((unsigned int) (a[i]))- ((unsigned int) ('0'))));
+ if (i < higha)
+ {
+ /* avoid dangling else. */
+ i += 1;
+ if ((a[i] < '0') || (a[i] > '7'))
+ {
+ ok = FALSE;
+ }
+ }
+ else
+ {
+ ok = FALSE;
+ }
+ } while (! (! ok));
+ }
+}
+
+extern "C" void _M2_NumberIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_NumberIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GPushBackInput.cc b/gcc/m2/mc-boot/GPushBackInput.cc
new file mode 100644
index 00000000000..e15b3eb9007
--- /dev/null
+++ b/gcc/m2/mc-boot/GPushBackInput.cc
@@ -0,0 +1,488 @@
+/* do not edit automatically generated by mc from PushBackInput. */
+/* PushBackInput.mod provides a method for pushing back and consuming input.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _PushBackInput_H
+#define _PushBackInput_C
+
+# include "GFIO.h"
+# include "GDynamicStrings.h"
+# include "GASCII.h"
+# include "GDebug.h"
+# include "GStrLib.h"
+# include "GNumberIO.h"
+# include "GStrIO.h"
+# include "GStdIO.h"
+# include "Glibc.h"
+
+# define MaxPushBackStack 8192
+# define MaxFileName 4096
+typedef struct PushBackInput__T2_a PushBackInput__T2;
+
+typedef struct PushBackInput__T3_a PushBackInput__T3;
+
+struct PushBackInput__T2_a { char array[MaxFileName+1]; };
+struct PushBackInput__T3_a { char array[MaxPushBackStack+1]; };
+static PushBackInput__T2 FileName;
+static PushBackInput__T3 CharStack;
+static unsigned int ExitStatus;
+static unsigned int Column;
+static unsigned int StackPtr;
+static unsigned int LineNo;
+static unsigned int Debugging;
+
+/*
+ Open - opens a file for reading.
+*/
+
+extern "C" FIO_File PushBackInput_Open (const char *a_, unsigned int _a_high);
+
+/*
+ GetCh - gets a character from either the push back stack or
+ from file, f.
+*/
+
+extern "C" char PushBackInput_GetCh (FIO_File f);
+
+/*
+ PutCh - pushes a character onto the push back stack, it also
+ returns the character which has been pushed.
+*/
+
+extern "C" char PushBackInput_PutCh (char ch);
+
+/*
+ PutString - pushes a string onto the push back stack.
+*/
+
+extern "C" void PushBackInput_PutString (const char *a_, unsigned int _a_high);
+
+/*
+ PutStr - pushes a dynamic string onto the push back stack.
+ The string, s, is not deallocated.
+*/
+
+extern "C" void PushBackInput_PutStr (DynamicStrings_String s);
+
+/*
+ Error - emits an error message with the appropriate file, line combination.
+*/
+
+extern "C" void PushBackInput_Error (const char *a_, unsigned int _a_high);
+
+/*
+ WarnError - emits an error message with the appropriate file, line combination.
+ It does not terminate but when the program finishes an exit status of
+ 1 will be issued.
+*/
+
+extern "C" void PushBackInput_WarnError (const char *a_, unsigned int _a_high);
+
+/*
+ WarnString - emits an error message with the appropriate file, line combination.
+ It does not terminate but when the program finishes an exit status of
+ 1 will be issued.
+*/
+
+extern "C" void PushBackInput_WarnString (DynamicStrings_String s);
+
+/*
+ Close - closes the opened file.
+*/
+
+extern "C" void PushBackInput_Close (FIO_File f);
+
+/*
+ GetExitStatus - returns the exit status which will be 1 if any warnings were issued.
+*/
+
+extern "C" unsigned int PushBackInput_GetExitStatus (void);
+
+/*
+ SetDebug - sets the debug flag on or off.
+*/
+
+extern "C" void PushBackInput_SetDebug (unsigned int d);
+
+/*
+ GetColumnPosition - returns the column position of the current character.
+*/
+
+extern "C" unsigned int PushBackInput_GetColumnPosition (void);
+
+/*
+ GetCurrentLine - returns the current line number.
+*/
+
+extern "C" unsigned int PushBackInput_GetCurrentLine (void);
+
+/*
+ ErrChar - writes a char, ch, to stderr.
+*/
+
+static void ErrChar (char ch);
+
+/*
+ Init - initialize global variables.
+*/
+
+static void Init (void);
+
+
+/*
+ ErrChar - writes a char, ch, to stderr.
+*/
+
+static void ErrChar (char ch)
+{
+ FIO_WriteChar (FIO_StdErr, ch);
+}
+
+
+/*
+ Init - initialize global variables.
+*/
+
+static void Init (void)
+{
+ ExitStatus = 0;
+ StackPtr = 0;
+ LineNo = 1;
+ Column = 0;
+}
+
+
+/*
+ Open - opens a file for reading.
+*/
+
+extern "C" FIO_File PushBackInput_Open (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ Init ();
+ StrLib_StrCopy ((const char *) a, _a_high, (char *) &FileName.array[0], MaxFileName);
+ return FIO_OpenToRead ((const char *) a, _a_high);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetCh - gets a character from either the push back stack or
+ from file, f.
+*/
+
+extern "C" char PushBackInput_GetCh (FIO_File f)
+{
+ char ch;
+
+ if (StackPtr > 0)
+ {
+ StackPtr -= 1;
+ if (Debugging)
+ {
+ StdIO_Write (CharStack.array[StackPtr]);
+ }
+ return CharStack.array[StackPtr];
+ }
+ else
+ {
+ if ((FIO_EOF (f)) || (! (FIO_IsNoError (f))))
+ {
+ ch = ASCII_nul;
+ }
+ else
+ {
+ do {
+ ch = FIO_ReadChar (f);
+ } while (! (((ch != ASCII_cr) || (FIO_EOF (f))) || (! (FIO_IsNoError (f)))));
+ if (ch == ASCII_lf)
+ {
+ Column = 0;
+ LineNo += 1;
+ }
+ else
+ {
+ Column += 1;
+ }
+ }
+ if (Debugging)
+ {
+ StdIO_Write (ch);
+ }
+ return ch;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PutCh - pushes a character onto the push back stack, it also
+ returns the character which has been pushed.
+*/
+
+extern "C" char PushBackInput_PutCh (char ch)
+{
+ if (StackPtr < MaxPushBackStack)
+ {
+ CharStack.array[StackPtr] = ch;
+ StackPtr += 1;
+ }
+ else
+ {
+ Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ }
+ return ch;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PutString - pushes a string onto the push back stack.
+*/
+
+extern "C" void PushBackInput_PutString (const char *a_, unsigned int _a_high)
+{
+ unsigned int l;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ l = StrLib_StrLen ((const char *) a, _a_high);
+ while (l > 0)
+ {
+ l -= 1;
+ if ((PushBackInput_PutCh (a[l])) != a[l])
+ {
+ Debug_Halt ((const char *) "assert failed", 13, 132, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ }
+ }
+}
+
+
+/*
+ PutStr - pushes a dynamic string onto the push back stack.
+ The string, s, is not deallocated.
+*/
+
+extern "C" void PushBackInput_PutStr (DynamicStrings_String s)
+{
+ unsigned int i;
+
+ i = DynamicStrings_Length (s);
+ while (i > 0)
+ {
+ i -= 1;
+ if ((PushBackInput_PutCh (DynamicStrings_char (s, static_cast<int> (i)))) != (DynamicStrings_char (s, static_cast<int> (i))))
+ {
+ Debug_Halt ((const char *) "assert failed", 13, 113, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ }
+ }
+}
+
+
+/*
+ Error - emits an error message with the appropriate file, line combination.
+*/
+
+extern "C" void PushBackInput_Error (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) ErrChar});
+ StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ StdIO_Write (':');
+ NumberIO_WriteCard (LineNo, 0);
+ StdIO_Write (':');
+ StrIO_WriteString ((const char *) a, _a_high);
+ StrIO_WriteLn ();
+ StdIO_PopOutput ();
+ FIO_Close (FIO_StdErr);
+ libc_exit (1);
+}
+
+
+/*
+ WarnError - emits an error message with the appropriate file, line combination.
+ It does not terminate but when the program finishes an exit status of
+ 1 will be issued.
+*/
+
+extern "C" void PushBackInput_WarnError (const char *a_, unsigned int _a_high)
+{
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) ErrChar});
+ StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ StdIO_Write (':');
+ NumberIO_WriteCard (LineNo, 0);
+ StdIO_Write (':');
+ StrIO_WriteString ((const char *) a, _a_high);
+ StrIO_WriteLn ();
+ StdIO_PopOutput ();
+ ExitStatus = 1;
+}
+
+
+/*
+ WarnString - emits an error message with the appropriate file, line combination.
+ It does not terminate but when the program finishes an exit status of
+ 1 will be issued.
+*/
+
+extern "C" void PushBackInput_WarnString (DynamicStrings_String s)
+{
+ typedef char *WarnString__T1;
+
+ WarnString__T1 p;
+
+ p = static_cast<WarnString__T1> (DynamicStrings_string (s));
+ StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ StdIO_Write (':');
+ NumberIO_WriteCard (LineNo, 0);
+ StdIO_Write (':');
+ do {
+ if (p != NULL)
+ {
+ if ((*p) == ASCII_lf)
+ {
+ StrIO_WriteLn ();
+ StrIO_WriteString ((const char *) &FileName.array[0], MaxFileName);
+ StdIO_Write (':');
+ NumberIO_WriteCard (LineNo, 0);
+ StdIO_Write (':');
+ }
+ else
+ {
+ StdIO_Write ((*p));
+ }
+ p += 1;
+ }
+ } while (! ((p == NULL) || ((*p) == ASCII_nul)));
+ ExitStatus = 1;
+}
+
+
+/*
+ Close - closes the opened file.
+*/
+
+extern "C" void PushBackInput_Close (FIO_File f)
+{
+ FIO_Close (f);
+}
+
+
+/*
+ GetExitStatus - returns the exit status which will be 1 if any warnings were issued.
+*/
+
+extern "C" unsigned int PushBackInput_GetExitStatus (void)
+{
+ return ExitStatus;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetDebug - sets the debug flag on or off.
+*/
+
+extern "C" void PushBackInput_SetDebug (unsigned int d)
+{
+ Debugging = d;
+}
+
+
+/*
+ GetColumnPosition - returns the column position of the current character.
+*/
+
+extern "C" unsigned int PushBackInput_GetColumnPosition (void)
+{
+ if (StackPtr > Column)
+ {
+ return 0;
+ }
+ else
+ {
+ return Column-StackPtr;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetCurrentLine - returns the current line number.
+*/
+
+extern "C" unsigned int PushBackInput_GetCurrentLine (void)
+{
+ return LineNo;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_PushBackInput_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ PushBackInput_SetDebug (FALSE);
+ Init ();
+}
+
+extern "C" void _M2_PushBackInput_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GRTExceptions.cc b/gcc/m2/mc-boot/GRTExceptions.cc
new file mode 100644
index 00000000000..23f8fede117
--- /dev/null
+++ b/gcc/m2/mc-boot/GRTExceptions.cc
@@ -0,0 +1,1223 @@
+/* do not edit automatically generated by mc from RTExceptions. */
+/* RTExceptions.mod runtime exception handler routines.
+
+Copyright (C) 2008-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+# include "Gmcrts.h"
+#ifndef __cplusplus
+extern void throw (unsigned int);
+#endif
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _RTExceptions_H
+#define _RTExceptions_C
+
+# include "GASCII.h"
+# include "GStrLib.h"
+# include "GStorage.h"
+# include "GSYSTEM.h"
+# include "Glibc.h"
+# include "GM2RTS.h"
+# include "GSysExceptions.h"
+# include "GM2EXCEPTION.h"
+
+typedef struct RTExceptions_ProcedureHandler_p RTExceptions_ProcedureHandler;
+
+# define MaxBuffer 4096
+typedef struct RTExceptions__T1_r RTExceptions__T1;
+
+typedef char *RTExceptions_PtrToChar;
+
+typedef struct RTExceptions__T2_a RTExceptions__T2;
+
+typedef struct RTExceptions__T3_r RTExceptions__T3;
+
+typedef RTExceptions__T3 *RTExceptions_Handler;
+
+typedef RTExceptions__T1 *RTExceptions_EHBlock;
+
+typedef void (*RTExceptions_ProcedureHandler_t) (void);
+struct RTExceptions_ProcedureHandler_p { RTExceptions_ProcedureHandler_t proc; };
+
+struct RTExceptions__T2_a { char array[MaxBuffer+1]; };
+struct RTExceptions__T1_r {
+ RTExceptions__T2 buffer;
+ unsigned int number;
+ RTExceptions_Handler handlers;
+ RTExceptions_EHBlock right;
+ };
+
+struct RTExceptions__T3_r {
+ RTExceptions_ProcedureHandler p;
+ unsigned int n;
+ RTExceptions_Handler right;
+ RTExceptions_Handler left;
+ RTExceptions_Handler stack;
+ };
+
+static unsigned int inException;
+static RTExceptions_Handler freeHandler;
+static RTExceptions_EHBlock freeEHB;
+static RTExceptions_EHBlock currentEHB;
+static void * currentSource;
+
+/*
+ Raise - invoke the exception handler associated with, number,
+ in the active EHBlock. It keeps a record of the number
+ and message in the EHBlock for later use.
+*/
+
+extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message) __attribute__ ((noreturn));
+
+/*
+ SetExceptionBlock - sets, source, as the active EHB.
+*/
+
+extern "C" void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source);
+
+/*
+ GetExceptionBlock - returns the active EHB.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void);
+
+/*
+ GetTextBuffer - returns the address of the EHB buffer.
+*/
+
+extern "C" void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e);
+
+/*
+ GetTextBufferSize - return the size of the EHB text buffer.
+*/
+
+extern "C" unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e);
+
+/*
+ GetNumber - return the exception number associated with,
+ source.
+*/
+
+extern "C" unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source);
+
+/*
+ InitExceptionBlock - creates and returns a new exception block.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void);
+
+/*
+ KillExceptionBlock - destroys the EHB, e, and all its handlers.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e);
+
+/*
+ PushHandler - install a handler in EHB, e.
+*/
+
+extern "C" void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p);
+
+/*
+ PopHandler - removes the handler associated with, number, from
+ EHB, e.
+*/
+
+extern "C" void RTExceptions_PopHandler (RTExceptions_EHBlock e, unsigned int number);
+
+/*
+ DefaultErrorCatch - displays the current error message in
+ the current exception block and then
+ calls HALT.
+*/
+
+extern "C" void RTExceptions_DefaultErrorCatch (void);
+
+/*
+ BaseExceptionsThrow - configures the Modula-2 exceptions to call
+ THROW which in turn can be caught by an
+ exception block. If this is not called then
+ a Modula-2 exception will simply call an
+ error message routine and then HALT.
+*/
+
+extern "C" void RTExceptions_BaseExceptionsThrow (void);
+
+/*
+ IsInExceptionState - returns TRUE if the program is currently
+ in the exception state.
+*/
+
+extern "C" unsigned int RTExceptions_IsInExceptionState (void);
+
+/*
+ SetExceptionState - returns the current exception state and
+ then sets the current exception state to,
+ to.
+*/
+
+extern "C" unsigned int RTExceptions_SetExceptionState (unsigned int to);
+
+/*
+ SwitchExceptionState - assigns, from, with the current exception
+ state and then assigns the current exception
+ to, to.
+*/
+
+extern "C" void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to);
+
+/*
+ GetBaseExceptionBlock - returns the initial language exception block
+ created.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void);
+
+/*
+ SetExceptionSource - sets the current exception source to, source.
+*/
+
+extern "C" void RTExceptions_SetExceptionSource (void * source);
+
+/*
+ GetExceptionSource - returns the current exception source.
+*/
+
+extern "C" void * RTExceptions_GetExceptionSource (void);
+
+/*
+ ErrorString - writes a string to stderr.
+*/
+
+static void ErrorString (const char *a_, unsigned int _a_high);
+
+/*
+ findHandler -
+*/
+
+static RTExceptions_Handler findHandler (RTExceptions_EHBlock e, unsigned int number);
+
+/*
+ InvokeHandler - invokes the associated handler for the current
+ exception in the active EHB.
+*/
+
+static void InvokeHandler (void) __attribute__ ((noreturn));
+
+/*
+ DoThrow - throw the exception number in the exception block.
+*/
+
+static void DoThrow (void);
+
+/*
+ addChar - adds, ch, to the current exception handler text buffer
+ at index, i. The index in then incremented.
+*/
+
+static void addChar (char ch, unsigned int *i);
+
+/*
+ stripPath - returns the filename from the path.
+*/
+
+static void * stripPath (void * s);
+
+/*
+ addFile - adds the filename determined by, s, however it strips
+ any preceeding path.
+*/
+
+static void addFile (void * s, unsigned int *i);
+
+/*
+ addStr - adds a C string from address, s, into the current
+ handler text buffer.
+*/
+
+static void addStr (void * s, unsigned int *i);
+
+/*
+ addNum - adds a number, n, to the current handler
+ text buffer.
+*/
+
+static void addNum (unsigned int n, unsigned int *i);
+
+/*
+ New - returns a new EHBlock.
+*/
+
+static RTExceptions_EHBlock New (void);
+
+/*
+ NewHandler - returns a new handler.
+*/
+
+static RTExceptions_Handler NewHandler (void);
+
+/*
+ KillHandler - returns, NIL, and places, h, onto the free list.
+*/
+
+static RTExceptions_Handler KillHandler (RTExceptions_Handler h);
+
+/*
+ KillHandlers - kills all handlers in the list.
+*/
+
+static RTExceptions_Handler KillHandlers (RTExceptions_Handler h);
+
+/*
+ InitHandler -
+*/
+
+static RTExceptions_Handler InitHandler (RTExceptions_Handler h, RTExceptions_Handler l, RTExceptions_Handler r, RTExceptions_Handler s, unsigned int number, RTExceptions_ProcedureHandler proc);
+
+/*
+ SubHandler -
+*/
+
+static void SubHandler (RTExceptions_Handler h);
+
+/*
+ AddHandler - add, e, to the end of the list of handlers.
+*/
+
+static void AddHandler (RTExceptions_EHBlock e, RTExceptions_Handler h);
+
+/*
+ indexf - raise an index out of bounds exception.
+*/
+
+static void indexf (void * a);
+
+/*
+ range - raise an assignment out of range exception.
+*/
+
+static void range (void * a);
+
+/*
+ casef - raise a case selector out of range exception.
+*/
+
+static void casef (void * a);
+
+/*
+ invalidloc - raise an invalid location exception.
+*/
+
+static void invalidloc (void * a);
+
+/*
+ function - raise a ... function ... exception. --fixme-- what does this exception catch?
+*/
+
+static void function (void * a);
+
+/*
+ wholevalue - raise an illegal whole value exception.
+*/
+
+static void wholevalue (void * a);
+
+/*
+ wholediv - raise a division by zero exception.
+*/
+
+static void wholediv (void * a);
+
+/*
+ realvalue - raise an illegal real value exception.
+*/
+
+static void realvalue (void * a);
+
+/*
+ realdiv - raise a division by zero in a real number exception.
+*/
+
+static void realdiv (void * a);
+
+/*
+ complexvalue - raise an illegal complex value exception.
+*/
+
+static void complexvalue (void * a);
+
+/*
+ complexdiv - raise a division by zero in a complex number exception.
+*/
+
+static void complexdiv (void * a);
+
+/*
+ protection - raise a protection exception.
+*/
+
+static void protection (void * a);
+
+/*
+ systemf - raise a system exception.
+*/
+
+static void systemf (void * a);
+
+/*
+ coroutine - raise a coroutine exception.
+*/
+
+static void coroutine (void * a);
+
+/*
+ exception - raise a exception exception.
+*/
+
+static void exception (void * a);
+
+/*
+ Init - initialises this module.
+*/
+
+static void Init (void);
+
+/*
+ TidyUp - deallocate memory used by this module.
+*/
+
+static void TidyUp (void);
+
+
+/*
+ ErrorString - writes a string to stderr.
+*/
+
+static void ErrorString (const char *a_, unsigned int _a_high)
+{
+ int n;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ n = static_cast<int> (libc_write (2, &a, static_cast<size_t> (StrLib_StrLen ((const char *) a, _a_high))));
+}
+
+
+/*
+ findHandler -
+*/
+
+static RTExceptions_Handler findHandler (RTExceptions_EHBlock e, unsigned int number)
+{
+ RTExceptions_Handler h;
+
+ h = e->handlers->right;
+ while ((h != e->handlers) && (number != h->n))
+ {
+ h = h->right;
+ }
+ if (h == e->handlers)
+ {
+ return NULL;
+ }
+ else
+ {
+ return h;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InvokeHandler - invokes the associated handler for the current
+ exception in the active EHB.
+*/
+
+static void InvokeHandler (void)
+{
+ RTExceptions_Handler h;
+
+ h = findHandler (currentEHB, currentEHB->number);
+ if (h == NULL)
+ {
+ throw (RTExceptions_GetNumber (RTExceptions_GetExceptionBlock ()));
+ }
+ else
+ {
+ (*h->p.proc) ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+}
+
+
+/*
+ DoThrow - throw the exception number in the exception block.
+*/
+
+static void DoThrow (void)
+{
+ throw (RTExceptions_GetNumber (RTExceptions_GetExceptionBlock ()));
+}
+
+
+/*
+ addChar - adds, ch, to the current exception handler text buffer
+ at index, i. The index in then incremented.
+*/
+
+static void addChar (char ch, unsigned int *i)
+{
+ if (((*i) <= MaxBuffer) && (currentEHB != NULL))
+ {
+ currentEHB->buffer.array[(*i)] = ch;
+ (*i) += 1;
+ }
+}
+
+
+/*
+ stripPath - returns the filename from the path.
+*/
+
+static void * stripPath (void * s)
+{
+ RTExceptions_PtrToChar f;
+ RTExceptions_PtrToChar p;
+
+ p = static_cast<RTExceptions_PtrToChar> (s);
+ f = static_cast<RTExceptions_PtrToChar> (s);
+ while ((*p) != ASCII_nul)
+ {
+ if ((*p) == '/')
+ {
+ p += 1;
+ f = p;
+ }
+ else
+ {
+ p += 1;
+ }
+ }
+ return reinterpret_cast<void *> (f);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ addFile - adds the filename determined by, s, however it strips
+ any preceeding path.
+*/
+
+static void addFile (void * s, unsigned int *i)
+{
+ RTExceptions_PtrToChar p;
+
+ p = static_cast<RTExceptions_PtrToChar> (stripPath (s));
+ while ((p != NULL) && ((*p) != ASCII_nul))
+ {
+ addChar ((*p), i);
+ p += 1;
+ }
+}
+
+
+/*
+ addStr - adds a C string from address, s, into the current
+ handler text buffer.
+*/
+
+static void addStr (void * s, unsigned int *i)
+{
+ RTExceptions_PtrToChar p;
+
+ p = static_cast<RTExceptions_PtrToChar> (s);
+ while ((p != NULL) && ((*p) != ASCII_nul))
+ {
+ addChar ((*p), i);
+ p += 1;
+ }
+}
+
+
+/*
+ addNum - adds a number, n, to the current handler
+ text buffer.
+*/
+
+static void addNum (unsigned int n, unsigned int *i)
+{
+ if (n < 10)
+ {
+ addChar ( ((char) ((n % 10)+ ((unsigned int) ('0')))), i);
+ }
+ else
+ {
+ addNum (n / 10, i);
+ addNum (n % 10, i);
+ }
+}
+
+
+/*
+ New - returns a new EHBlock.
+*/
+
+static RTExceptions_EHBlock New (void)
+{
+ RTExceptions_EHBlock e;
+
+ if (freeEHB == NULL)
+ {
+ Storage_ALLOCATE ((void **) &e, sizeof (RTExceptions__T1));
+ }
+ else
+ {
+ e = freeEHB;
+ freeEHB = freeEHB->right;
+ }
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ NewHandler - returns a new handler.
+*/
+
+static RTExceptions_Handler NewHandler (void)
+{
+ RTExceptions_Handler h;
+
+ if (freeHandler == NULL)
+ {
+ Storage_ALLOCATE ((void **) &h, sizeof (RTExceptions__T3));
+ }
+ else
+ {
+ h = freeHandler;
+ freeHandler = freeHandler->right;
+ }
+ return h;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillHandler - returns, NIL, and places, h, onto the free list.
+*/
+
+static RTExceptions_Handler KillHandler (RTExceptions_Handler h)
+{
+ h->right = freeHandler;
+ freeHandler = h;
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillHandlers - kills all handlers in the list.
+*/
+
+static RTExceptions_Handler KillHandlers (RTExceptions_Handler h)
+{
+ h->left->right = freeHandler;
+ freeHandler = h;
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitHandler -
+*/
+
+static RTExceptions_Handler InitHandler (RTExceptions_Handler h, RTExceptions_Handler l, RTExceptions_Handler r, RTExceptions_Handler s, unsigned int number, RTExceptions_ProcedureHandler proc)
+{
+ h->p = proc;
+ h->n = number;
+ h->right = r;
+ h->left = l;
+ h->stack = s;
+ return h;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SubHandler -
+*/
+
+static void SubHandler (RTExceptions_Handler h)
+{
+ h->right->left = h->left;
+ h->left->right = h->right;
+}
+
+
+/*
+ AddHandler - add, e, to the end of the list of handlers.
+*/
+
+static void AddHandler (RTExceptions_EHBlock e, RTExceptions_Handler h)
+{
+ h->right = e->handlers;
+ h->left = e->handlers->left;
+ e->handlers->left->right = h;
+ e->handlers->left = h;
+}
+
+
+/*
+ indexf - raise an index out of bounds exception.
+*/
+
+static void indexf (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 613, 9, const_cast<void*> (reinterpret_cast<const void*>("indexf")), const_cast<void*> (reinterpret_cast<const void*>("array index out of bounds")));
+}
+
+
+/*
+ range - raise an assignment out of range exception.
+*/
+
+static void range (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 625, 9, const_cast<void*> (reinterpret_cast<const void*>("range")), const_cast<void*> (reinterpret_cast<const void*>("assignment out of range")));
+}
+
+
+/*
+ casef - raise a case selector out of range exception.
+*/
+
+static void casef (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 637, 9, const_cast<void*> (reinterpret_cast<const void*>("casef")), const_cast<void*> (reinterpret_cast<const void*>("case selector out of range")));
+}
+
+
+/*
+ invalidloc - raise an invalid location exception.
+*/
+
+static void invalidloc (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 649, 9, const_cast<void*> (reinterpret_cast<const void*>("invalidloc")), const_cast<void*> (reinterpret_cast<const void*>("invalid address referenced")));
+}
+
+
+/*
+ function - raise a ... function ... exception. --fixme-- what does this exception catch?
+*/
+
+static void function (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 661, 9, const_cast<void*> (reinterpret_cast<const void*>("function")), const_cast<void*> (reinterpret_cast<const void*>("... function ... "))); /* --fixme-- what has happened ? */
+}
+
+
+/*
+ wholevalue - raise an illegal whole value exception.
+*/
+
+static void wholevalue (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 673, 9, const_cast<void*> (reinterpret_cast<const void*>("wholevalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
+}
+
+
+/*
+ wholediv - raise a division by zero exception.
+*/
+
+static void wholediv (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 685, 9, const_cast<void*> (reinterpret_cast<const void*>("wholediv")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
+}
+
+
+/*
+ realvalue - raise an illegal real value exception.
+*/
+
+static void realvalue (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 697, 9, const_cast<void*> (reinterpret_cast<const void*>("realvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal real value exception")));
+}
+
+
+/*
+ realdiv - raise a division by zero in a real number exception.
+*/
+
+static void realdiv (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 709, 9, const_cast<void*> (reinterpret_cast<const void*>("realdiv")), const_cast<void*> (reinterpret_cast<const void*>("real number division by zero exception")));
+}
+
+
+/*
+ complexvalue - raise an illegal complex value exception.
+*/
+
+static void complexvalue (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 721, 9, const_cast<void*> (reinterpret_cast<const void*>("complexvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal complex value exception")));
+}
+
+
+/*
+ complexdiv - raise a division by zero in a complex number exception.
+*/
+
+static void complexdiv (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 733, 9, const_cast<void*> (reinterpret_cast<const void*>("complexdiv")), const_cast<void*> (reinterpret_cast<const void*>("complex number division by zero exception")));
+}
+
+
+/*
+ protection - raise a protection exception.
+*/
+
+static void protection (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 745, 9, const_cast<void*> (reinterpret_cast<const void*>("protection")), const_cast<void*> (reinterpret_cast<const void*>("protection exception")));
+}
+
+
+/*
+ systemf - raise a system exception.
+*/
+
+static void systemf (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 757, 9, const_cast<void*> (reinterpret_cast<const void*>("systemf")), const_cast<void*> (reinterpret_cast<const void*>("system exception")));
+}
+
+
+/*
+ coroutine - raise a coroutine exception.
+*/
+
+static void coroutine (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 769, 9, const_cast<void*> (reinterpret_cast<const void*>("coroutine")), const_cast<void*> (reinterpret_cast<const void*>("coroutine exception")));
+}
+
+
+/*
+ exception - raise a exception exception.
+*/
+
+static void exception (void * a)
+{
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 781, 9, const_cast<void*> (reinterpret_cast<const void*>("exception")), const_cast<void*> (reinterpret_cast<const void*>("exception exception")));
+}
+
+
+/*
+ Init - initialises this module.
+*/
+
+static void Init (void)
+{
+ inException = FALSE;
+ freeHandler = NULL;
+ freeEHB = NULL;
+ currentEHB = RTExceptions_InitExceptionBlock ();
+ currentSource = NULL;
+ RTExceptions_BaseExceptionsThrow ();
+ SysExceptions_InitExceptionHandlers ((SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) indexf}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) range}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) casef}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) invalidloc}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) function}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) wholevalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) wholediv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) realvalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) realdiv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) complexvalue}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) complexdiv}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) protection}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) systemf}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) coroutine}, (SysExceptions_PROCEXCEPTION) {(SysExceptions_PROCEXCEPTION_t) exception});
+}
+
+
+/*
+ TidyUp - deallocate memory used by this module.
+*/
+
+static void TidyUp (void)
+{
+ RTExceptions_Handler f;
+ RTExceptions_EHBlock e;
+
+ if (currentEHB != NULL)
+ {
+ currentEHB = RTExceptions_KillExceptionBlock (currentEHB);
+ }
+ while (freeHandler != NULL)
+ {
+ f = freeHandler;
+ freeHandler = freeHandler->right;
+ Storage_DEALLOCATE ((void **) &f, sizeof (RTExceptions__T3));
+ }
+ while (freeEHB != NULL)
+ {
+ e = freeEHB;
+ freeEHB = freeEHB->right;
+ Storage_DEALLOCATE ((void **) &e, sizeof (RTExceptions__T1));
+ }
+}
+
+
+/*
+ Raise - invoke the exception handler associated with, number,
+ in the active EHBlock. It keeps a record of the number
+ and message in the EHBlock for later use.
+*/
+
+extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message)
+{
+ unsigned int i;
+
+ currentEHB->number = number;
+ i = 0;
+ addFile (file, &i);
+ addChar (':', &i);
+ addNum (line, &i);
+ addChar (':', &i);
+ addNum (column, &i);
+ addChar (':', &i);
+ addChar (' ', &i);
+ addChar ('I', &i);
+ addChar ('n', &i);
+ addChar (' ', &i);
+ addStr (function, &i);
+ addChar (ASCII_nl, &i);
+ addFile (file, &i);
+ addChar (':', &i);
+ addNum (line, &i);
+ addChar (':', &i);
+ addNum (column, &i);
+ addChar (':', &i);
+ addStr (message, &i);
+ addChar (ASCII_nl, &i);
+ addChar (ASCII_nul, &i);
+ InvokeHandler ();
+}
+
+
+/*
+ SetExceptionBlock - sets, source, as the active EHB.
+*/
+
+extern "C" void RTExceptions_SetExceptionBlock (RTExceptions_EHBlock source)
+{
+ currentEHB = source;
+}
+
+
+/*
+ GetExceptionBlock - returns the active EHB.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_GetExceptionBlock (void)
+{
+ return currentEHB;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetTextBuffer - returns the address of the EHB buffer.
+*/
+
+extern "C" void * RTExceptions_GetTextBuffer (RTExceptions_EHBlock e)
+{
+ return &e->buffer;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetTextBufferSize - return the size of the EHB text buffer.
+*/
+
+extern "C" unsigned int RTExceptions_GetTextBufferSize (RTExceptions_EHBlock e)
+{
+ return sizeof (e->buffer);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ GetNumber - return the exception number associated with,
+ source.
+*/
+
+extern "C" unsigned int RTExceptions_GetNumber (RTExceptions_EHBlock source)
+{
+ return source->number;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitExceptionBlock - creates and returns a new exception block.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_InitExceptionBlock (void)
+{
+ RTExceptions_EHBlock e;
+
+ e = New ();
+ e->number = UINT_MAX;
+ e->handlers = NewHandler (); /* add the dummy onto the head */
+ e->handlers->right = e->handlers; /* add the dummy onto the head */
+ e->handlers->left = e->handlers;
+ e->right = e;
+ return e;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ KillExceptionBlock - destroys the EHB, e, and all its handlers.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_KillExceptionBlock (RTExceptions_EHBlock e)
+{
+ e->handlers = KillHandlers (e->handlers);
+ e->right = freeEHB;
+ freeEHB = e;
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ PushHandler - install a handler in EHB, e.
+*/
+
+extern "C" void RTExceptions_PushHandler (RTExceptions_EHBlock e, unsigned int number, RTExceptions_ProcedureHandler p)
+{
+ RTExceptions_Handler h;
+ RTExceptions_Handler i;
+
+ h = findHandler (e, number);
+ if (h == NULL)
+ {
+ i = InitHandler (NewHandler (), NULL, NULL, NULL, number, p);
+ }
+ else
+ {
+ /* remove, h, */
+ SubHandler (h);
+ /* stack it onto a new handler */
+ i = InitHandler (NewHandler (), NULL, NULL, h, number, p);
+ }
+ /* add new handler */
+ AddHandler (e, i);
+}
+
+
+/*
+ PopHandler - removes the handler associated with, number, from
+ EHB, e.
+*/
+
+extern "C" void RTExceptions_PopHandler (RTExceptions_EHBlock e, unsigned int number)
+{
+ RTExceptions_Handler h;
+ RTExceptions_Handler i;
+
+ h = findHandler (e, number);
+ if (h != NULL)
+ {
+ /* remove, h, */
+ SubHandler (h);
+ if (h->stack != NULL)
+ {
+ AddHandler (e, h->stack);
+ }
+ h = KillHandler (h);
+ }
+}
+
+
+/*
+ DefaultErrorCatch - displays the current error message in
+ the current exception block and then
+ calls HALT.
+*/
+
+extern "C" void RTExceptions_DefaultErrorCatch (void)
+{
+ RTExceptions_EHBlock e;
+ int n;
+
+ e = RTExceptions_GetExceptionBlock ();
+ n = static_cast<int> (libc_write (2, RTExceptions_GetTextBuffer (e), libc_strlen (RTExceptions_GetTextBuffer (e))));
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ BaseExceptionsThrow - configures the Modula-2 exceptions to call
+ THROW which in turn can be caught by an
+ exception block. If this is not called then
+ a Modula-2 exception will simply call an
+ error message routine and then HALT.
+*/
+
+extern "C" void RTExceptions_BaseExceptionsThrow (void)
+{
+ M2EXCEPTION_M2Exceptions i;
+
+ for (i=M2EXCEPTION_indexException; i<=M2EXCEPTION_exException; i= static_cast<M2EXCEPTION_M2Exceptions>(static_cast<int>(i+1)))
+ {
+ RTExceptions_PushHandler (RTExceptions_GetExceptionBlock (), (unsigned int ) (i), (RTExceptions_ProcedureHandler) {(RTExceptions_ProcedureHandler_t) DoThrow});
+ }
+}
+
+
+/*
+ IsInExceptionState - returns TRUE if the program is currently
+ in the exception state.
+*/
+
+extern "C" unsigned int RTExceptions_IsInExceptionState (void)
+{
+ return inException;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetExceptionState - returns the current exception state and
+ then sets the current exception state to,
+ to.
+*/
+
+extern "C" unsigned int RTExceptions_SetExceptionState (unsigned int to)
+{
+ unsigned int old;
+
+ old = inException;
+ inException = to;
+ return old;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SwitchExceptionState - assigns, from, with the current exception
+ state and then assigns the current exception
+ to, to.
+*/
+
+extern "C" void RTExceptions_SwitchExceptionState (unsigned int *from, unsigned int to)
+{
+ (*from) = inException;
+ inException = to;
+}
+
+
+/*
+ GetBaseExceptionBlock - returns the initial language exception block
+ created.
+*/
+
+extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void)
+{
+ if (currentEHB == NULL)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod", 53, 599, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
+ }
+ else
+ {
+ return currentEHB;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ SetExceptionSource - sets the current exception source to, source.
+*/
+
+extern "C" void RTExceptions_SetExceptionSource (void * source)
+{
+ currentSource = source;
+}
+
+
+/*
+ GetExceptionSource - returns the current exception source.
+*/
+
+extern "C" void * RTExceptions_GetExceptionSource (void)
+{
+ return currentSource;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_RTExceptions_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ Init ();
+}
+
+extern "C" void _M2_RTExceptions_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ TidyUp ();
+}
diff --git a/gcc/m2/mc-boot/GRTint.cc b/gcc/m2/mc-boot/GRTint.cc
new file mode 100644
index 00000000000..a3030f2d9a1
--- /dev/null
+++ b/gcc/m2/mc-boot/GRTint.cc
@@ -0,0 +1,1106 @@
+/* do not edit automatically generated by mc from RTint. */
+/* RTint.mod provides users of the COROUTINES library with the.
+
+Copyright (C) 2009-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+# include "GStorage.h"
+# include "Gmcrts.h"
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _RTint_H
+#define _RTint_C
+
+# include "GM2RTS.h"
+# include "GStorage.h"
+# include "GRTco.h"
+# include "GCOROUTINES.h"
+# include "Glibc.h"
+# include "GAssertion.h"
+# include "GSelective.h"
+
+typedef struct RTint_DispatchVector_p RTint_DispatchVector;
+
+# define Microseconds 1000000
+# define DebugTime 0
+# define Debugging FALSE
+typedef struct RTint__T1_r RTint__T1;
+
+typedef RTint__T1 *RTint_Vector;
+
+typedef struct RTint__T2_a RTint__T2;
+
+typedef enum {RTint_input, RTint_output, RTint_time} RTint_VectorType;
+
+typedef void (*RTint_DispatchVector_t) (unsigned int, unsigned int, void *);
+struct RTint_DispatchVector_p { RTint_DispatchVector_t proc; };
+
+struct RTint__T1_r {
+ RTint_VectorType type;
+ unsigned int priority;
+ void *arg;
+ RTint_Vector pending;
+ RTint_Vector exists;
+ unsigned int no;
+ int File;
+ Selective_Timeval rel;
+ Selective_Timeval abs_;
+ unsigned int queued;
+ };
+
+struct RTint__T2_a { RTint_Vector array[(7)-(COROUTINES_UnassignedPriority)+1]; };
+static unsigned int VecNo;
+static RTint_Vector Exists;
+static RTint__T2 Pending;
+static int lock;
+static unsigned int initialized;
+
+/*
+ InitInputVector - returns an interrupt vector which is associated
+ with the file descriptor, fd.
+*/
+
+extern "C" unsigned int RTint_InitInputVector (int fd, unsigned int pri);
+
+/*
+ InitOutputVector - returns an interrupt vector which is associated
+ with the file descriptor, fd.
+*/
+
+extern "C" unsigned int RTint_InitOutputVector (int fd, unsigned int pri);
+
+/*
+ InitTimeVector - returns an interrupt vector associated with
+ the relative time.
+*/
+
+extern "C" unsigned int RTint_InitTimeVector (unsigned int micro, unsigned int secs, unsigned int pri);
+
+/*
+ ReArmTimeVector - reprimes the vector, vec, to deliver an interrupt
+ at the new relative time.
+*/
+
+extern "C" void RTint_ReArmTimeVector (unsigned int vec, unsigned int micro, unsigned int secs);
+
+/*
+ GetTimeVector - assigns, micro, and, secs, with the remaining
+ time before this interrupt will expire.
+ This value is only updated when a Listen
+ occurs.
+*/
+
+extern "C" void RTint_GetTimeVector (unsigned int vec, unsigned int *micro, unsigned int *secs);
+
+/*
+ AttachVector - adds the pointer ptr to be associated with the interrupt
+ vector. It returns the previous value attached to this
+ vector.
+*/
+
+extern "C" void * RTint_AttachVector (unsigned int vec, void * ptr);
+
+/*
+ IncludeVector - includes, vec, into the dispatcher list of
+ possible interrupt causes.
+*/
+
+extern "C" void RTint_IncludeVector (unsigned int vec);
+
+/*
+ ExcludeVector - excludes, vec, from the dispatcher list of
+ possible interrupt causes.
+*/
+
+extern "C" void RTint_ExcludeVector (unsigned int vec);
+
+/*
+ Listen - will either block indefinitely (until an interrupt)
+ or alteratively will test to see whether any interrupts
+ are pending.
+ If a pending interrupt was found then, call, is called
+ and then this procedure returns.
+ It only listens for interrupts > pri.
+*/
+
+extern "C" void RTint_Listen (unsigned int untilInterrupt, RTint_DispatchVector call, unsigned int pri);
+
+/*
+ Init -
+*/
+
+extern "C" void RTint_Init (void);
+
+/*
+ Max - returns the maximum: i or j.
+*/
+
+static int Max (int i, int j);
+static int Min (int i, int j);
+
+/*
+ FindVector - searches the exists list for a vector of type
+ which is associated with file descriptor, fd.
+*/
+
+static RTint_Vector FindVector (int fd, RTint_VectorType type);
+
+/*
+ FindVectorNo - searches the Exists list for vector vec.
+*/
+
+static RTint_Vector FindVectorNo (unsigned int vec);
+
+/*
+ FindPendingVector - searches the pending list for vector, vec.
+*/
+
+static RTint_Vector FindPendingVector (unsigned int vec);
+
+/*
+ AddFd - adds the file descriptor fd to set updating max.
+*/
+
+static void AddFd (Selective_SetOfFd *set, int *max, int fd);
+
+/*
+ DumpPendingQueue - displays the pending queue.
+*/
+
+static void DumpPendingQueue (void);
+
+/*
+ AddTime - t1 := t1 + t2
+*/
+
+static void AddTime (Selective_Timeval t1, Selective_Timeval t2);
+
+/*
+ IsGreaterEqual - returns TRUE if, a>=b
+*/
+
+static unsigned int IsGreaterEqual (Selective_Timeval a, Selective_Timeval b);
+
+/*
+ SubTime - assigns, s and m, to a - b.
+*/
+
+static void SubTime (unsigned int *s, unsigned int *m, Selective_Timeval a, Selective_Timeval b);
+
+/*
+ activatePending - activates the first interrupt pending and clears it.
+*/
+
+static unsigned int activatePending (unsigned int untilInterrupt, RTint_DispatchVector call, unsigned int pri, int maxFd, Selective_SetOfFd *inSet, Selective_SetOfFd *outSet, Selective_Timeval *timeval, Selective_Timeval b4, Selective_Timeval after);
+
+/*
+ init -
+*/
+
+static void init (void);
+
+
+/*
+ Max - returns the maximum: i or j.
+*/
+
+static int Max (int i, int j)
+{
+ if (i > j)
+ {
+ return i;
+ }
+ else
+ {
+ return j;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+static int Min (int i, int j)
+{
+ /*
+ Max - returns the minimum: i or j.
+ */
+ if (i < j)
+ {
+ return i;
+ }
+ else
+ {
+ return j;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FindVector - searches the exists list for a vector of type
+ which is associated with file descriptor, fd.
+*/
+
+static RTint_Vector FindVector (int fd, RTint_VectorType type)
+{
+ RTint_Vector vec;
+
+ vec = Exists;
+ while (vec != NULL)
+ {
+ if ((vec->type == type) && (vec->File == fd))
+ {
+ return vec;
+ }
+ vec = vec->exists;
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FindVectorNo - searches the Exists list for vector vec.
+*/
+
+static RTint_Vector FindVectorNo (unsigned int vec)
+{
+ RTint_Vector vptr;
+
+ vptr = Exists;
+ while ((vptr != NULL) && (vptr->no != vec))
+ {
+ vptr = vptr->exists;
+ }
+ return vptr;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ FindPendingVector - searches the pending list for vector, vec.
+*/
+
+static RTint_Vector FindPendingVector (unsigned int vec)
+{
+ unsigned int pri;
+ RTint_Vector vptr;
+
+ for (pri=COROUTINES_UnassignedPriority; pri<=7; pri++)
+ {
+ vptr = Pending.array[pri-(COROUTINES_UnassignedPriority)];
+ while ((vptr != NULL) && (vptr->no != vec))
+ {
+ vptr = vptr->pending;
+ }
+ if ((vptr != NULL) && (vptr->no == vec))
+ {
+ return vptr;
+ }
+ }
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ AddFd - adds the file descriptor fd to set updating max.
+*/
+
+static void AddFd (Selective_SetOfFd *set, int *max, int fd)
+{
+ (*max) = Max (fd, (*max));
+ if ((*set) == NULL)
+ {
+ (*set) = Selective_InitSet ();
+ Selective_FdZero ((*set));
+ }
+ /* printf('%d, ', fd) */
+ Selective_FdSet (fd, (*set));
+}
+
+
+/*
+ DumpPendingQueue - displays the pending queue.
+*/
+
+static void DumpPendingQueue (void)
+{
+ COROUTINES_PROTECTION pri;
+ RTint_Vector vptr;
+ unsigned int sec;
+ unsigned int micro;
+
+ libc_printf ((const char *) "Pending queue\\n", 15);
+ for (pri=COROUTINES_UnassignedPriority; pri<=7; pri++)
+ {
+ libc_printf ((const char *) "[%d] ", 6, pri);
+ vptr = Pending.array[pri-(COROUTINES_UnassignedPriority)];
+ while (vptr != NULL)
+ {
+ if ((vptr->type == RTint_input) || (vptr->type == RTint_output))
+ {
+ libc_printf ((const char *) "(fd=%d) (vec=%d)", 16, vptr->File, vptr->no);
+ }
+ else if (vptr->type == RTint_time)
+ {
+ /* avoid dangling else. */
+ Selective_GetTime (vptr->rel, &sec, µ);
+ Assertion_Assert (micro < Microseconds);
+ libc_printf ((const char *) "time (%u.%06u secs) (arg = %p)\\n", 32, sec, micro, vptr->arg);
+ }
+ vptr = vptr->pending;
+ }
+ libc_printf ((const char *) " \\n", 3);
+ }
+}
+
+
+/*
+ AddTime - t1 := t1 + t2
+*/
+
+static void AddTime (Selective_Timeval t1, Selective_Timeval t2)
+{
+ unsigned int a;
+ unsigned int b;
+ unsigned int s;
+ unsigned int m;
+
+ Selective_GetTime (t1, &s, &m);
+ Assertion_Assert (m < Microseconds);
+ Selective_GetTime (t2, &a, &b);
+ Assertion_Assert (b < Microseconds);
+ a += s;
+ b += m;
+ if (b >= Microseconds)
+ {
+ b -= Microseconds;
+ a += 1;
+ }
+ Selective_SetTime (t1, a, b);
+}
+
+
+/*
+ IsGreaterEqual - returns TRUE if, a>=b
+*/
+
+static unsigned int IsGreaterEqual (Selective_Timeval a, Selective_Timeval b)
+{
+ unsigned int as;
+ unsigned int am;
+ unsigned int bs;
+ unsigned int bm;
+
+ Selective_GetTime (a, &as, &am);
+ Assertion_Assert (am < Microseconds);
+ Selective_GetTime (b, &bs, &bm);
+ Assertion_Assert (bm < Microseconds);
+ return (as > bs) || ((as == bs) && (am >= bm));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ SubTime - assigns, s and m, to a - b.
+*/
+
+static void SubTime (unsigned int *s, unsigned int *m, Selective_Timeval a, Selective_Timeval b)
+{
+ unsigned int as;
+ unsigned int am;
+ unsigned int bs;
+ unsigned int bm;
+
+ Selective_GetTime (a, &as, &am);
+ Assertion_Assert (am < Microseconds);
+ Selective_GetTime (b, &bs, &bm);
+ Assertion_Assert (bm < Microseconds);
+ if (IsGreaterEqual (a, b))
+ {
+ (*s) = as-bs;
+ if (am >= bm)
+ {
+ (*m) = am-bm;
+ Assertion_Assert ((*m) < Microseconds);
+ }
+ else
+ {
+ Assertion_Assert ((*s) > 0);
+ (*s) -= 1;
+ (*m) = (Microseconds+am)-bm;
+ Assertion_Assert ((*m) < Microseconds);
+ }
+ }
+ else
+ {
+ (*s) = 0;
+ (*m) = 0;
+ }
+}
+
+
+/*
+ activatePending - activates the first interrupt pending and clears it.
+*/
+
+static unsigned int activatePending (unsigned int untilInterrupt, RTint_DispatchVector call, unsigned int pri, int maxFd, Selective_SetOfFd *inSet, Selective_SetOfFd *outSet, Selective_Timeval *timeval, Selective_Timeval b4, Selective_Timeval after)
+{
+ int result;
+ unsigned int p;
+ RTint_Vector vec;
+ unsigned int b4s;
+ unsigned int b4m;
+ unsigned int afs;
+ unsigned int afm;
+ unsigned int sec;
+ unsigned int micro;
+
+ RTco_wait (lock);
+ p = static_cast<unsigned int> (7);
+ while (p > pri)
+ {
+ vec = Pending.array[p-(COROUTINES_UnassignedPriority)];
+ while (vec != NULL)
+ {
+ switch (vec->type)
+ {
+ case RTint_input:
+ if (((vec->File < maxFd) && ((*inSet) != NULL)) && (Selective_FdIsSet (vec->File, (*inSet))))
+ {
+ if (Debugging)
+ {
+ libc_printf ((const char *) "read (fd=%d) is ready (vec=%d)\\n", 32, vec->File, vec->no);
+ DumpPendingQueue ();
+ }
+ Selective_FdClr (vec->File, (*inSet)); /* so we dont activate this again from our select. */
+ RTco_signal (lock); /* so we dont activate this again from our select. */
+ (*call.proc) (vec->no, vec->priority, vec->arg);
+ return TRUE;
+ }
+ break;
+
+ case RTint_output:
+ if (((vec->File < maxFd) && ((*outSet) != NULL)) && (Selective_FdIsSet (vec->File, (*outSet))))
+ {
+ if (Debugging)
+ {
+ libc_printf ((const char *) "write (fd=%d) is ready (vec=%d)\\n", 33, vec->File, vec->no);
+ DumpPendingQueue ();
+ }
+ Selective_FdClr (vec->File, (*outSet)); /* so we dont activate this again from our select. */
+ RTco_signal (lock); /* so we dont activate this again from our select. */
+ (*call.proc) (vec->no, vec->priority, vec->arg);
+ return TRUE;
+ }
+ break;
+
+ case RTint_time:
+ if (untilInterrupt && ((*timeval) != NULL))
+ {
+ result = Selective_GetTimeOfDay (after);
+ Assertion_Assert (result == 0);
+ if (Debugging)
+ {
+ Selective_GetTime ((*timeval), &sec, µ);
+ Assertion_Assert (micro < Microseconds);
+ Selective_GetTime (after, &afs, &afm);
+ Assertion_Assert (afm < Microseconds);
+ Selective_GetTime (b4, &b4s, &b4m);
+ Assertion_Assert (b4m < Microseconds);
+ libc_printf ((const char *) "waited %u.%06u + %u.%06u now is %u.%06u\\n", 41, sec, micro, b4s, b4m, afs, afm);
+ }
+ if (IsGreaterEqual (after, vec->abs_))
+ {
+ if (Debugging)
+ {
+ DumpPendingQueue ();
+ libc_printf ((const char *) "time has expired calling dispatcher\\n", 37);
+ }
+ (*timeval) = Selective_KillTime ((*timeval)); /* so we dont activate this again from our select. */
+ RTco_signal (lock); /* so we dont activate this again from our select. */
+ if (Debugging)
+ {
+ libc_printf ((const char *) "call (%d, %d, 0x%x)\\n", 21, vec->no, vec->priority, vec->arg);
+ }
+ (*call.proc) (vec->no, vec->priority, vec->arg);
+ return TRUE;
+ }
+ else if (Debugging)
+ {
+ /* avoid dangling else. */
+ libc_printf ((const char *) "must wait longer as time has not expired\\n", 42);
+ }
+ }
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ __builtin_unreachable ();
+ }
+ vec = vec->pending;
+ }
+ p -= 1;
+ }
+ RTco_signal (lock);
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ init -
+*/
+
+static void init (void)
+{
+ COROUTINES_PROTECTION p;
+
+ lock = RTco_initSemaphore (1);
+ RTco_wait (lock);
+ Exists = NULL;
+ for (p=COROUTINES_UnassignedPriority; p<=7; p++)
+ {
+ Pending.array[p-(COROUTINES_UnassignedPriority)] = NULL;
+ }
+ initialized = TRUE;
+ RTco_signal (lock);
+}
+
+
+/*
+ InitInputVector - returns an interrupt vector which is associated
+ with the file descriptor, fd.
+*/
+
+extern "C" unsigned int RTint_InitInputVector (int fd, unsigned int pri)
+{
+ RTint_Vector vptr;
+
+ if (Debugging)
+ {
+ libc_printf ((const char *) "InitInputVector fd = %d priority = %d\\n", 39, fd, pri);
+ }
+ RTco_wait (lock);
+ vptr = FindVector (fd, RTint_input);
+ if (vptr == NULL)
+ {
+ Storage_ALLOCATE ((void **) &vptr, sizeof (RTint__T1));
+ VecNo += 1;
+ vptr->type = RTint_input;
+ vptr->priority = pri;
+ vptr->arg = NULL;
+ vptr->pending = NULL;
+ vptr->exists = Exists;
+ vptr->no = VecNo;
+ vptr->File = fd;
+ Exists = vptr;
+ RTco_signal (lock);
+ return VecNo;
+ }
+ else
+ {
+ RTco_signal (lock);
+ return vptr->no;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitOutputVector - returns an interrupt vector which is associated
+ with the file descriptor, fd.
+*/
+
+extern "C" unsigned int RTint_InitOutputVector (int fd, unsigned int pri)
+{
+ RTint_Vector vptr;
+
+ RTco_wait (lock);
+ vptr = FindVector (fd, RTint_output);
+ if (vptr == NULL)
+ {
+ Storage_ALLOCATE ((void **) &vptr, sizeof (RTint__T1));
+ if (vptr == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ VecNo += 1;
+ vptr->type = RTint_output;
+ vptr->priority = pri;
+ vptr->arg = NULL;
+ vptr->pending = NULL;
+ vptr->exists = Exists;
+ vptr->no = VecNo;
+ vptr->File = fd;
+ Exists = vptr;
+ RTco_signal (lock);
+ return VecNo;
+ }
+ }
+ else
+ {
+ RTco_signal (lock);
+ return vptr->no;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ InitTimeVector - returns an interrupt vector associated with
+ the relative time.
+*/
+
+extern "C" unsigned int RTint_InitTimeVector (unsigned int micro, unsigned int secs, unsigned int pri)
+{
+ RTint_Vector vptr;
+
+ RTco_wait (lock);
+ Storage_ALLOCATE ((void **) &vptr, sizeof (RTint__T1));
+ if (vptr == NULL)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ VecNo += 1;
+ Assertion_Assert (micro < Microseconds);
+ vptr->type = RTint_time;
+ vptr->priority = pri;
+ vptr->arg = NULL;
+ vptr->pending = NULL;
+ vptr->exists = Exists;
+ vptr->no = VecNo;
+ vptr->rel = Selective_InitTime (secs+DebugTime, micro);
+ vptr->abs_ = Selective_InitTime (0, 0);
+ vptr->queued = FALSE;
+ Exists = vptr;
+ }
+ RTco_signal (lock);
+ return VecNo;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ReArmTimeVector - reprimes the vector, vec, to deliver an interrupt
+ at the new relative time.
+*/
+
+extern "C" void RTint_ReArmTimeVector (unsigned int vec, unsigned int micro, unsigned int secs)
+{
+ RTint_Vector vptr;
+
+ Assertion_Assert (micro < Microseconds);
+ RTco_wait (lock);
+ vptr = FindVectorNo (vec);
+ if (vptr == NULL)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 286, (const char *) "ReArmTimeVector", 15, (const char *) "cannot find vector supplied", 27);
+ }
+ else
+ {
+ Selective_SetTime (vptr->rel, secs+DebugTime, micro);
+ }
+ RTco_signal (lock);
+}
+
+
+/*
+ GetTimeVector - assigns, micro, and, secs, with the remaining
+ time before this interrupt will expire.
+ This value is only updated when a Listen
+ occurs.
+*/
+
+extern "C" void RTint_GetTimeVector (unsigned int vec, unsigned int *micro, unsigned int *secs)
+{
+ RTint_Vector vptr;
+
+ RTco_wait (lock);
+ vptr = FindVectorNo (vec);
+ if (vptr == NULL)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 312, (const char *) "GetTimeVector", 13, (const char *) "cannot find vector supplied", 27);
+ }
+ else
+ {
+ Selective_GetTime (vptr->rel, secs, micro);
+ Assertion_Assert ((*micro) < Microseconds);
+ }
+ RTco_signal (lock);
+}
+
+
+/*
+ AttachVector - adds the pointer ptr to be associated with the interrupt
+ vector. It returns the previous value attached to this
+ vector.
+*/
+
+extern "C" void * RTint_AttachVector (unsigned int vec, void * ptr)
+{
+ RTint_Vector vptr;
+ void * prevArg;
+
+ RTco_wait (lock);
+ vptr = FindVectorNo (vec);
+ if (vptr == NULL)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 339, (const char *) "AttachVector", 12, (const char *) "cannot find vector supplied", 27);
+ }
+ else
+ {
+ prevArg = vptr->arg;
+ vptr->arg = ptr;
+ if (Debugging)
+ {
+ libc_printf ((const char *) "AttachVector %d with %p\\n", 25, vec, ptr);
+ DumpPendingQueue ();
+ }
+ RTco_signal (lock);
+ return prevArg;
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ IncludeVector - includes, vec, into the dispatcher list of
+ possible interrupt causes.
+*/
+
+extern "C" void RTint_IncludeVector (unsigned int vec)
+{
+ RTint_Vector vptr;
+ unsigned int micro;
+ unsigned int sec;
+ int result;
+
+ RTco_wait (lock);
+ vptr = FindPendingVector (vec);
+ if (vptr == NULL)
+ {
+ /* avoid dangling else. */
+ vptr = FindVectorNo (vec);
+ if (vptr == NULL)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 372, (const char *) "IncludeVector", 13, (const char *) "cannot find vector supplied", 27);
+ }
+ else
+ {
+ /* printf('including vector %d (fd = %d)
+ ', vec, v^.File) ; */
+ vptr->pending = Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)];
+ Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)] = vptr;
+ if ((vptr->type == RTint_time) && ! vptr->queued)
+ {
+ vptr->queued = TRUE;
+ result = Selective_GetTimeOfDay (vptr->abs_);
+ Assertion_Assert (result == 0);
+ Selective_GetTime (vptr->abs_, &sec, µ);
+ Assertion_Assert (micro < Microseconds);
+ AddTime (vptr->abs_, vptr->rel);
+ Selective_GetTime (vptr->abs_, &sec, µ);
+ Assertion_Assert (micro < Microseconds);
+ }
+ }
+ }
+ else
+ {
+ if (Debugging)
+ {
+ libc_printf ((const char *) "odd vector (%d) type (%d) arg (%p) is already attached to the pending queue\\n", 77, vec, vptr->type, vptr->arg);
+ }
+ }
+ RTco_signal (lock);
+}
+
+
+/*
+ ExcludeVector - excludes, vec, from the dispatcher list of
+ possible interrupt causes.
+*/
+
+extern "C" void RTint_ExcludeVector (unsigned int vec)
+{
+ RTint_Vector vptr;
+ RTint_Vector uptr;
+
+ RTco_wait (lock);
+ vptr = FindPendingVector (vec);
+ if (vptr == NULL)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 414, (const char *) "ExcludeVector", 13, (const char *) "cannot find pending vector supplied", 35);
+ }
+ else
+ {
+ /* printf('excluding vector %d
+ ', vec) ; */
+ if (Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)] == vptr)
+ {
+ Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)] = Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)]->pending;
+ }
+ else
+ {
+ uptr = Pending.array[vptr->priority-(COROUTINES_UnassignedPriority)];
+ while (uptr->pending != vptr)
+ {
+ uptr = uptr->pending;
+ }
+ uptr->pending = vptr->pending;
+ }
+ if (vptr->type == RTint_time)
+ {
+ vptr->queued = FALSE;
+ }
+ }
+ RTco_signal (lock);
+}
+
+
+/*
+ Listen - will either block indefinitely (until an interrupt)
+ or alteratively will test to see whether any interrupts
+ are pending.
+ If a pending interrupt was found then, call, is called
+ and then this procedure returns.
+ It only listens for interrupts > pri.
+*/
+
+extern "C" void RTint_Listen (unsigned int untilInterrupt, RTint_DispatchVector call, unsigned int pri)
+{
+ unsigned int found;
+ int result;
+ Selective_Timeval after;
+ Selective_Timeval b4;
+ Selective_Timeval timeval;
+ RTint_Vector vec;
+ Selective_SetOfFd inSet;
+ Selective_SetOfFd outSet;
+ unsigned int b4s;
+ unsigned int b4m;
+ unsigned int afs;
+ unsigned int afm;
+ unsigned int sec;
+ unsigned int micro;
+ int maxFd;
+ unsigned int p;
+
+ RTco_wait (lock);
+ if (pri < (7))
+ {
+ if (Debugging)
+ {
+ DumpPendingQueue ();
+ }
+ maxFd = -1;
+ timeval = NULL;
+ inSet = NULL;
+ outSet = NULL;
+ timeval = Selective_InitTime (static_cast<unsigned int> (INT_MAX), 0);
+ p = static_cast<unsigned int> (7);
+ found = FALSE;
+ while (p > pri)
+ {
+ vec = Pending.array[p-(COROUTINES_UnassignedPriority)];
+ while (vec != NULL)
+ {
+ switch (vec->type)
+ {
+ case RTint_input:
+ AddFd (&inSet, &maxFd, vec->File);
+ break;
+
+ case RTint_output:
+ AddFd (&outSet, &maxFd, vec->File);
+ break;
+
+ case RTint_time:
+ if (IsGreaterEqual (timeval, vec->abs_))
+ {
+ Selective_GetTime (vec->abs_, &sec, µ);
+ Assertion_Assert (micro < Microseconds);
+ if (Debugging)
+ {
+ libc_printf ((const char *) "shortest delay is %u.%06u\\n", 27, sec, micro);
+ }
+ Selective_SetTime (timeval, sec, micro);
+ found = TRUE;
+ }
+ break;
+
+
+ default:
+ CaseException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ __builtin_unreachable ();
+ }
+ vec = vec->pending;
+ }
+ p -= 1;
+ }
+ if (! untilInterrupt)
+ {
+ Selective_SetTime (timeval, 0, 0);
+ }
+ if (((untilInterrupt && (inSet == NULL)) && (outSet == NULL)) && ! found)
+ {
+ M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 730, (const char *) "Listen", 6, (const char *) "deadlock found, no more processes to run and no interrupts active", 65);
+ }
+ /* printf('}
+ ') ; */
+ if (((! found && (maxFd == -1)) && (inSet == NULL)) && (outSet == NULL))
+ {
+ /* no file descriptors to be selected upon. */
+ timeval = Selective_KillTime (timeval);
+ RTco_signal (lock);
+ return ;
+ }
+ else
+ {
+ Selective_GetTime (timeval, &sec, µ);
+ Assertion_Assert (micro < Microseconds);
+ b4 = Selective_InitTime (0, 0);
+ after = Selective_InitTime (0, 0);
+ result = Selective_GetTimeOfDay (b4);
+ Assertion_Assert (result == 0);
+ SubTime (&sec, µ, timeval, b4);
+ Selective_SetTime (timeval, sec, micro);
+ if (Debugging)
+ {
+ libc_printf ((const char *) "select waiting for %u.%06u seconds\\n", 36, sec, micro);
+ }
+ RTco_signal (lock);
+ do {
+ if (Debugging)
+ {
+ libc_printf ((const char *) "select (.., .., .., %u.%06u)\\n", 30, sec, micro);
+ }
+ result = RTco_select (maxFd+1, inSet, outSet, NULL, timeval);
+ if (result == -1)
+ {
+ libc_perror ((const char *) "select", 6);
+ result = RTco_select (maxFd+1, inSet, outSet, NULL, NULL);
+ if (result == -1)
+ {
+ libc_perror ((const char *) "select timeout argument is faulty", 33);
+ }
+ result = RTco_select (maxFd+1, inSet, NULL, NULL, timeval);
+ if (result == -1)
+ {
+ libc_perror ((const char *) "select output fd argument is faulty", 35);
+ }
+ result = RTco_select (maxFd+1, NULL, outSet, NULL, timeval);
+ if (result == -1)
+ {
+ libc_perror ((const char *) "select input fd argument is faulty", 34);
+ }
+ else
+ {
+ libc_perror ((const char *) "select maxFD+1 argument is faulty", 33);
+ }
+ }
+ } while (! (result != -1));
+ }
+ while (activatePending (untilInterrupt, call, pri, maxFd+1, &inSet, &outSet, &timeval, b4, after))
+ {} /* empty. */
+ if (timeval != NULL)
+ {
+ timeval = Selective_KillTime (timeval);
+ }
+ if (after != NULL)
+ {
+ after = Selective_KillTime (after);
+ }
+ if (b4 != NULL)
+ {
+ b4 = Selective_KillTime (b4);
+ }
+ if (inSet != NULL)
+ {
+ inSet = Selective_KillSet (inSet);
+ }
+ if (outSet != NULL)
+ {
+ outSet = Selective_KillSet (outSet);
+ }
+ }
+ RTco_signal (lock);
+}
+
+
+/*
+ Init -
+*/
+
+extern "C" void RTint_Init (void)
+{
+ if (! initialized)
+ {
+ init ();
+ }
+}
+
+extern "C" void _M2_RTint_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ RTint_Init ();
+}
+
+extern "C" void _M2_RTint_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GSArgs.cc b/gcc/m2/mc-boot/GSArgs.cc
new file mode 100644
index 00000000000..143d2783c16
--- /dev/null
+++ b/gcc/m2/mc-boot/GSArgs.cc
@@ -0,0 +1,125 @@
+/* do not edit automatically generated by mc from SArgs. */
+/* SArgs.mod provides a String interface to the command line arguments.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _SArgs_H
+#define _SArgs_C
+
+# include "GSYSTEM.h"
+# include "GUnixArgs.h"
+# include "GDynamicStrings.h"
+
+typedef char *SArgs_PtrToChar;
+
+typedef SArgs_PtrToChar *SArgs_PtrToPtrToChar;
+
+
+/*
+ GetArg - returns the nth argument from the command line.
+ The success of the operation is returned.
+ If TRUE is returned then the string, s, contains a
+ new string, otherwise s is set to NIL.
+*/
+
+extern "C" unsigned int SArgs_GetArg (DynamicStrings_String *s, unsigned int n);
+
+/*
+ Narg - returns the number of arguments available from
+ command line.
+*/
+
+extern "C" unsigned int SArgs_Narg (void);
+
+
+/*
+ GetArg - returns the nth argument from the command line.
+ The success of the operation is returned.
+ If TRUE is returned then the string, s, contains a
+ new string, otherwise s is set to NIL.
+*/
+
+extern "C" unsigned int SArgs_GetArg (DynamicStrings_String *s, unsigned int n)
+{
+ int i;
+ SArgs_PtrToPtrToChar ppc;
+
+ i = (int ) (n);
+ if (i < (UnixArgs_GetArgC ()))
+ {
+ /* ppc := ADDRESS (VAL (PtrToPtrToChar, ArgV) + (i * CARDINAL (TSIZE(PtrToChar)))) ; */
+ ppc = static_cast<SArgs_PtrToPtrToChar> ((void *) (((SArgs_PtrToChar) (UnixArgs_GetArgV ()))+(n*sizeof (SArgs_PtrToChar))));
+ (*s) = DynamicStrings_InitStringCharStar (reinterpret_cast<void *> ((*ppc)));
+ return TRUE;
+ }
+ else
+ {
+ (*s) = static_cast<DynamicStrings_String> (NULL);
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Narg - returns the number of arguments available from
+ command line.
+*/
+
+extern "C" unsigned int SArgs_Narg (void)
+{
+ return UnixArgs_GetArgC ();
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_SArgs_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_SArgs_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GSFIO.cc b/gcc/m2/mc-boot/GSFIO.cc
new file mode 100644
index 00000000000..1a800138812
--- /dev/null
+++ b/gcc/m2/mc-boot/GSFIO.cc
@@ -0,0 +1,216 @@
+/* do not edit automatically generated by mc from SFIO. */
+/* SFIO.mod provides a String interface to the opening routines of FIO.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _SFIO_H
+#define _SFIO_C
+
+# include "GASCII.h"
+# include "GDynamicStrings.h"
+# include "GFIO.h"
+
+
+/*
+ Exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+extern "C" unsigned int SFIO_Exists (DynamicStrings_String fname);
+
+/*
+ OpenToRead - attempts to open a file, fname, for reading and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname);
+
+/*
+ OpenToWrite - attempts to open a file, fname, for write and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname);
+
+/*
+ OpenForRandom - attempts to open a file, fname, for random access
+ read or write and it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+ towrite, determines whether the file should be
+ opened for writing or reading.
+ if towrite is TRUE or whether the previous file should
+ be left alone, allowing this descriptor to seek
+ and modify an existing file.
+*/
+
+extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, unsigned int towrite, unsigned int newfile);
+
+/*
+ WriteS - writes a string, s, to, file. It returns the String, s.
+*/
+
+extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s);
+
+/*
+ ReadS - reads and returns a string from, file.
+ It stops reading the string at the end of line or end of file.
+ It consumes the newline at the end of line but does not place
+ this into the returned string.
+*/
+
+extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file);
+
+
+/*
+ Exists - returns TRUE if a file named, fname exists for reading.
+*/
+
+extern "C" unsigned int SFIO_Exists (DynamicStrings_String fname)
+{
+ return FIO_exists (DynamicStrings_string (fname), DynamicStrings_Length (fname));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ OpenToRead - attempts to open a file, fname, for reading and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File SFIO_OpenToRead (DynamicStrings_String fname)
+{
+ return FIO_openToRead (DynamicStrings_string (fname), DynamicStrings_Length (fname));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ OpenToWrite - attempts to open a file, fname, for write and
+ it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+*/
+
+extern "C" FIO_File SFIO_OpenToWrite (DynamicStrings_String fname)
+{
+ return FIO_openToWrite (DynamicStrings_string (fname), DynamicStrings_Length (fname));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ OpenForRandom - attempts to open a file, fname, for random access
+ read or write and it returns this file.
+ The success of this operation can be checked by
+ calling IsNoError.
+ towrite, determines whether the file should be
+ opened for writing or reading.
+ if towrite is TRUE or whether the previous file should
+ be left alone, allowing this descriptor to seek
+ and modify an existing file.
+*/
+
+extern "C" FIO_File SFIO_OpenForRandom (DynamicStrings_String fname, unsigned int towrite, unsigned int newfile)
+{
+ return FIO_openForRandom (DynamicStrings_string (fname), DynamicStrings_Length (fname), towrite, newfile);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WriteS - writes a string, s, to, file. It returns the String, s.
+*/
+
+extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file, DynamicStrings_String s)
+{
+ unsigned int nBytes;
+
+ if (s != NULL)
+ {
+ nBytes = FIO_WriteNBytes (file, DynamicStrings_Length (s), DynamicStrings_string (s));
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ReadS - reads and returns a string from, file.
+ It stops reading the string at the end of line or end of file.
+ It consumes the newline at the end of line but does not place
+ this into the returned string.
+*/
+
+extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file)
+{
+ DynamicStrings_String s;
+ unsigned int c;
+
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ while (((! (FIO_EOLN (file))) && (! (FIO_EOF (file)))) && (FIO_IsNoError (file)))
+ {
+ s = DynamicStrings_ConCatChar (s, FIO_ReadChar (file));
+ }
+ if (FIO_EOLN (file))
+ {
+ /* consume nl */
+ if ((FIO_ReadChar (file)) == ASCII_nul)
+ {} /* empty. */
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_SFIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_SFIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GStdIO.cc b/gcc/m2/mc-boot/GStdIO.cc
new file mode 100644
index 00000000000..41affe2a054
--- /dev/null
+++ b/gcc/m2/mc-boot/GStdIO.cc
@@ -0,0 +1,269 @@
+/* do not edit automatically generated by mc from StdIO. */
+/* StdIO.mod provides general Read and Write procedures.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# include "Gmcrts.h"
+#define _StdIO_H
+#define _StdIO_C
+
+# include "GIO.h"
+# include "GM2RTS.h"
+
+typedef struct StdIO_ProcWrite_p StdIO_ProcWrite;
+
+typedef struct StdIO_ProcRead_p StdIO_ProcRead;
+
+# define MaxStack 40
+typedef struct StdIO__T1_a StdIO__T1;
+
+typedef struct StdIO__T2_a StdIO__T2;
+
+typedef void (*StdIO_ProcWrite_t) (char);
+struct StdIO_ProcWrite_p { StdIO_ProcWrite_t proc; };
+
+typedef void (*StdIO_ProcRead_t) (char *);
+struct StdIO_ProcRead_p { StdIO_ProcRead_t proc; };
+
+struct StdIO__T1_a { StdIO_ProcWrite array[MaxStack+1]; };
+struct StdIO__T2_a { StdIO_ProcRead array[MaxStack+1]; };
+static StdIO__T1 StackW;
+static unsigned int StackWPtr;
+static StdIO__T2 StackR;
+static unsigned int StackRPtr;
+
+/*
+ Read - is the generic procedure that all higher application layers
+ should use to receive a character.
+*/
+
+extern "C" void StdIO_Read (char *ch);
+
+/*
+ Write - is the generic procedure that all higher application layers
+ should use to emit a character.
+*/
+
+extern "C" void StdIO_Write (char ch);
+
+/*
+ PushOutput - pushes the current Write procedure onto a stack,
+ any future references to Write will actually invoke
+ procedure, p.
+*/
+
+extern "C" void StdIO_PushOutput (StdIO_ProcWrite p);
+
+/*
+ PopOutput - restores Write to use the previous output procedure.
+*/
+
+extern "C" void StdIO_PopOutput (void);
+
+/*
+ GetCurrentOutput - returns the current output procedure.
+*/
+
+extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void);
+
+/*
+ PushInput - pushes the current Read procedure onto a stack,
+ any future references to Read will actually invoke
+ procedure, p.
+*/
+
+extern "C" void StdIO_PushInput (StdIO_ProcRead p);
+
+/*
+ PopInput - restores Write to use the previous output procedure.
+*/
+
+extern "C" void StdIO_PopInput (void);
+
+/*
+ GetCurrentInput - returns the current input procedure.
+*/
+
+extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void);
+
+
+/*
+ Read - is the generic procedure that all higher application layers
+ should use to receive a character.
+*/
+
+extern "C" void StdIO_Read (char *ch)
+{
+ (*StackR.array[StackRPtr].proc) (ch);
+}
+
+
+/*
+ Write - is the generic procedure that all higher application layers
+ should use to emit a character.
+*/
+
+extern "C" void StdIO_Write (char ch)
+{
+ (*StackW.array[StackWPtr].proc) (ch);
+}
+
+
+/*
+ PushOutput - pushes the current Write procedure onto a stack,
+ any future references to Write will actually invoke
+ procedure, p.
+*/
+
+extern "C" void StdIO_PushOutput (StdIO_ProcWrite p)
+{
+ if (StackWPtr == MaxStack)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ StackWPtr += 1;
+ StackW.array[StackWPtr] = p;
+ }
+}
+
+
+/*
+ PopOutput - restores Write to use the previous output procedure.
+*/
+
+extern "C" void StdIO_PopOutput (void)
+{
+ if (StackWPtr == 1)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ StackWPtr -= 1;
+ }
+}
+
+
+/*
+ GetCurrentOutput - returns the current output procedure.
+*/
+
+extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void)
+{
+ if (StackWPtr > 0)
+ {
+ return StackW.array[StackWPtr];
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+
+/*
+ PushInput - pushes the current Read procedure onto a stack,
+ any future references to Read will actually invoke
+ procedure, p.
+*/
+
+extern "C" void StdIO_PushInput (StdIO_ProcRead p)
+{
+ if (StackRPtr == MaxStack)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ StackRPtr += 1;
+ StackR.array[StackRPtr] = p;
+ }
+}
+
+
+/*
+ PopInput - restores Write to use the previous output procedure.
+*/
+
+extern "C" void StdIO_PopInput (void)
+{
+ if (StackRPtr == 1)
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ else
+ {
+ StackRPtr -= 1;
+ }
+}
+
+
+/*
+ GetCurrentInput - returns the current input procedure.
+*/
+
+extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void)
+{
+ if (StackRPtr > 0)
+ {
+ return StackR.array[StackRPtr];
+ }
+ else
+ {
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ }
+ ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_StdIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ StackWPtr = 0;
+ StackRPtr = 0;
+ StdIO_PushOutput ((StdIO_ProcWrite) {(StdIO_ProcWrite_t) IO_Write});
+ StdIO_PushInput ((StdIO_ProcRead) {(StdIO_ProcRead_t) IO_Read});
+}
+
+extern "C" void _M2_StdIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GStorage.cc b/gcc/m2/mc-boot/GStorage.cc
new file mode 100644
index 00000000000..5dac021d866
--- /dev/null
+++ b/gcc/m2/mc-boot/GStorage.cc
@@ -0,0 +1,74 @@
+/* do not edit automatically generated by mc from Storage. */
+/* Storage.mod provides access to the dynamic Storage handler.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _Storage_H
+#define _Storage_C
+
+# include "GSysStorage.h"
+
+extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size);
+extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size);
+extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size);
+extern "C" unsigned int Storage_Available (unsigned int Size);
+
+extern "C" void Storage_ALLOCATE (void * *a, unsigned int Size)
+{
+ SysStorage_ALLOCATE (a, Size);
+}
+
+extern "C" void Storage_DEALLOCATE (void * *a, unsigned int Size)
+{
+ SysStorage_DEALLOCATE (a, Size);
+}
+
+extern "C" void Storage_REALLOCATE (void * *a, unsigned int Size)
+{
+ SysStorage_REALLOCATE (a, Size);
+}
+
+extern "C" unsigned int Storage_Available (unsigned int Size)
+{
+ return SysStorage_Available (Size);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_Storage_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_Storage_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GStrCase.cc b/gcc/m2/mc-boot/GStrCase.cc
new file mode 100644
index 00000000000..e3491b6d75b
--- /dev/null
+++ b/gcc/m2/mc-boot/GStrCase.cc
@@ -0,0 +1,175 @@
+/* do not edit automatically generated by mc from StrCase. */
+/* StrCase.mod provides procedure to convert between text case.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+#define _StrCase_H
+#define _StrCase_C
+
+# include "GASCII.h"
+# include "GStrLib.h"
+
+
+/*
+ StrToUpperCase - converts string, a, to uppercase returning the
+ result in, b.
+*/
+
+extern "C" void StrCase_StrToUpperCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high);
+
+/*
+ StrToLowerCase - converts string, a, to lowercase returning the
+ result in, b.
+*/
+
+extern "C" void StrCase_StrToLowerCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high);
+
+/*
+ Cap - converts a lower case character into a capital character.
+ If the character is not a lower case character 'a'..'z'
+ then the character is simply returned unaltered.
+*/
+
+extern "C" char StrCase_Cap (char ch);
+
+/*
+ Lower - converts an upper case character into a lower case character.
+ If the character is not an upper case character 'A'..'Z'
+ then the character is simply returned unaltered.
+*/
+
+extern "C" char StrCase_Lower (char ch);
+
+
+/*
+ StrToUpperCase - converts string, a, to uppercase returning the
+ result in, b.
+*/
+
+extern "C" void StrCase_StrToUpperCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high)
+{
+ unsigned int higha;
+ unsigned int highb;
+ unsigned int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ highb = _b_high;
+ i = 0;
+ while (((i < higha) && (a[i] != ASCII_nul)) && (i < highb))
+ {
+ b[i] = StrCase_Cap (a[i]);
+ i += 1;
+ }
+ if (i < highb)
+ {
+ b[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ StrToLowerCase - converts string, a, to lowercase returning the
+ result in, b.
+*/
+
+extern "C" void StrCase_StrToLowerCase (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high)
+{
+ unsigned int higha;
+ unsigned int highb;
+ unsigned int i;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ highb = _b_high;
+ i = 0;
+ while (((i < higha) && (a[i] != ASCII_nul)) && (i < highb))
+ {
+ b[i] = StrCase_Lower (a[i]);
+ i += 1;
+ }
+ if (i < highb)
+ {
+ b[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ Cap - converts a lower case character into a capital character.
+ If the character is not a lower case character 'a'..'z'
+ then the character is simply returned unaltered.
+*/
+
+extern "C" char StrCase_Cap (char ch)
+{
+ if ((ch >= 'a') && (ch <= 'z'))
+ {
+ ch = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('a')))+ ((unsigned int) ('A'))));
+ }
+ return ch;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Lower - converts an upper case character into a lower case character.
+ If the character is not an upper case character 'A'..'Z'
+ then the character is simply returned unaltered.
+*/
+
+extern "C" char StrCase_Lower (char ch)
+{
+ if ((ch >= 'A') && (ch <= 'Z'))
+ {
+ ch = ((char) (( ((unsigned int) (ch))- ((unsigned int) ('A')))+ ((unsigned int) ('a'))));
+ }
+ return ch;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" void _M2_StrCase_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_StrCase_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GStrIO.cc b/gcc/m2/mc-boot/GStrIO.cc
new file mode 100644
index 00000000000..1e091bce545
--- /dev/null
+++ b/gcc/m2/mc-boot/GStrIO.cc
@@ -0,0 +1,277 @@
+/* do not edit automatically generated by mc from StrIO. */
+/* StrIO.mod provides simple string input output routines.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#define _StrIO_H
+#define _StrIO_C
+
+# include "GASCII.h"
+# include "GStdIO.h"
+# include "Glibc.h"
+
+static unsigned int IsATTY;
+
+/*
+ WriteLn - writes a carriage return and a newline
+ character.
+*/
+
+extern "C" void StrIO_WriteLn (void);
+
+/*
+ ReadString - reads a sequence of characters into a string.
+ Line editing accepts Del, Ctrl H, Ctrl W and
+ Ctrl U.
+*/
+
+extern "C" void StrIO_ReadString (char *a, unsigned int _a_high);
+
+/*
+ WriteString - writes a string to the default output.
+*/
+
+extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high);
+
+/*
+ Erase - writes a backspace, space and backspace to remove the
+ last character displayed.
+*/
+
+static void Erase (void);
+
+/*
+ Echo - echos the character, ch, onto the output channel if IsATTY
+ is true.
+*/
+
+static void Echo (char ch);
+
+/*
+ AlphaNum- returns true if character, ch, is an alphanumeric character.
+*/
+
+static unsigned int AlphaNum (char ch);
+
+
+/*
+ Erase - writes a backspace, space and backspace to remove the
+ last character displayed.
+*/
+
+static void Erase (void)
+{
+ Echo (ASCII_bs);
+ Echo (' ');
+ Echo (ASCII_bs);
+}
+
+
+/*
+ Echo - echos the character, ch, onto the output channel if IsATTY
+ is true.
+*/
+
+static void Echo (char ch)
+{
+ if (IsATTY)
+ {
+ StdIO_Write (ch);
+ }
+}
+
+
+/*
+ AlphaNum- returns true if character, ch, is an alphanumeric character.
+*/
+
+static unsigned int AlphaNum (char ch)
+{
+ return (((ch >= 'a') && (ch <= 'z')) || ((ch >= 'A') && (ch <= 'Z'))) || ((ch >= '0') && (ch <= '9'));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ WriteLn - writes a carriage return and a newline
+ character.
+*/
+
+extern "C" void StrIO_WriteLn (void)
+{
+ Echo (ASCII_cr);
+ StdIO_Write (ASCII_lf);
+}
+
+
+/*
+ ReadString - reads a sequence of characters into a string.
+ Line editing accepts Del, Ctrl H, Ctrl W and
+ Ctrl U.
+*/
+
+extern "C" void StrIO_ReadString (char *a, unsigned int _a_high)
+{
+ unsigned int n;
+ unsigned int high;
+ char ch;
+
+ high = _a_high;
+ n = 0;
+ do {
+ StdIO_Read (&ch);
+ if ((ch == ASCII_del) || (ch == ASCII_bs))
+ {
+ if (n == 0)
+ {
+ StdIO_Write (ASCII_bel);
+ }
+ else
+ {
+ Erase ();
+ n -= 1;
+ }
+ }
+ else if (ch == ASCII_nak)
+ {
+ /* avoid dangling else. */
+ while (n > 0)
+ {
+ Erase ();
+ n -= 1;
+ }
+ }
+ else if (ch == ASCII_etb)
+ {
+ /* avoid dangling else. */
+ if (n == 0)
+ {
+ Echo (ASCII_bel);
+ }
+ else if (AlphaNum (a[n-1]))
+ {
+ /* avoid dangling else. */
+ do {
+ Erase ();
+ n -= 1;
+ } while (! ((n == 0) || (! (AlphaNum (a[n-1])))));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ Erase ();
+ n -= 1;
+ }
+ }
+ else if (n <= high)
+ {
+ /* avoid dangling else. */
+ if ((ch == ASCII_cr) || (ch == ASCII_lf))
+ {
+ a[n] = ASCII_nul;
+ n += 1;
+ }
+ else if (ch == ASCII_ff)
+ {
+ /* avoid dangling else. */
+ a[0] = ch;
+ if (high > 0)
+ {
+ a[1] = ASCII_nul;
+ }
+ ch = ASCII_cr;
+ }
+ else if (ch >= ' ')
+ {
+ /* avoid dangling else. */
+ Echo (ch);
+ a[n] = ch;
+ n += 1;
+ }
+ else if (ch == ASCII_eof)
+ {
+ /* avoid dangling else. */
+ a[n] = ch;
+ n += 1;
+ ch = ASCII_cr;
+ if (n <= high)
+ {
+ a[n] = ASCII_nul;
+ }
+ }
+ }
+ else if (ch != ASCII_cr)
+ {
+ /* avoid dangling else. */
+ Echo (ASCII_bel);
+ }
+ } while (! ((ch == ASCII_cr) || (ch == ASCII_lf)));
+}
+
+
+/*
+ WriteString - writes a string to the default output.
+*/
+
+extern "C" void StrIO_WriteString (const char *a_, unsigned int _a_high)
+{
+ unsigned int n;
+ unsigned int high;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ high = _a_high;
+ n = 0;
+ while ((n <= high) && (a[n] != ASCII_nul))
+ {
+ StdIO_Write (a[n]);
+ n += 1;
+ }
+}
+
+extern "C" void _M2_StrIO_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+ /* IsATTY := isatty() */
+ IsATTY = FALSE;
+}
+
+extern "C" void _M2_StrIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GStrLib.cc b/gcc/m2/mc-boot/GStrLib.cc
new file mode 100644
index 00000000000..537eeb96356
--- /dev/null
+++ b/gcc/m2/mc-boot/GStrLib.cc
@@ -0,0 +1,346 @@
+/* do not edit automatically generated by mc from StrLib. */
+/* StrLib.mod provides string manipulation procedures.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#define _StrLib_H
+#define _StrLib_C
+
+# include "GASCII.h"
+
+
+/*
+ StrConCat - combines a and b into c.
+*/
+
+extern "C" void StrLib_StrConCat (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high, char *c, unsigned int _c_high);
+
+/*
+ StrLess - returns TRUE if string, a, alphabetically occurs before
+ string, b.
+*/
+
+extern "C" unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+extern "C" unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high);
+
+/*
+ StrCopy - copy string src into string dest providing dest is large enough.
+ If dest is smaller than a then src then the string is truncated when
+ dest is full. Add a nul character if there is room in dest.
+*/
+
+extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high);
+
+/*
+ IsSubString - returns true if b is a subcomponent of a.
+*/
+
+extern "C" unsigned int StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high);
+
+/*
+ StrRemoveWhitePrefix - copies string, into string, b, excluding any white
+ space infront of a.
+*/
+
+extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high);
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch);
+
+
+/*
+ IsWhite - returns TRUE if, ch, is a space or a tab.
+*/
+
+static unsigned int IsWhite (char ch)
+{
+ return (ch == ' ') || (ch == ASCII_tab);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StrConCat - combines a and b into c.
+*/
+
+extern "C" void StrLib_StrConCat (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high, char *c, unsigned int _c_high)
+{
+ unsigned int Highb;
+ unsigned int Highc;
+ unsigned int i;
+ unsigned int j;
+ char a[_a_high+1];
+ char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+
+ Highb = StrLib_StrLen ((const char *) b, _b_high);
+ Highc = _c_high;
+ StrLib_StrCopy ((const char *) a, _a_high, (char *) c, _c_high);
+ i = StrLib_StrLen ((const char *) c, _c_high);
+ j = 0;
+ while ((j < Highb) && (i <= Highc))
+ {
+ c[i] = b[j];
+ i += 1;
+ j += 1;
+ }
+ if (i <= Highc)
+ {
+ c[i] = ASCII_nul;
+ }
+}
+
+
+/*
+ StrLess - returns TRUE if string, a, alphabetically occurs before
+ string, b.
+*/
+
+extern "C" unsigned int StrLib_StrLess (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high)
+{
+ unsigned int Higha;
+ unsigned int Highb;
+ unsigned int i;
+ char a[_a_high+1];
+ char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+
+ Higha = StrLib_StrLen ((const char *) a, _a_high);
+ Highb = StrLib_StrLen ((const char *) b, _b_high);
+ i = 0;
+ while ((i < Higha) && (i < Highb))
+ {
+ if (a[i] < b[i])
+ {
+ return TRUE;
+ }
+ else if (a[i] > b[i])
+ {
+ /* avoid dangling else. */
+ return FALSE;
+ }
+ /* must be equal, move on to next character */
+ i += 1;
+ }
+ return Higha < Highb; /* substrings are equal so we go on length */
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" unsigned int StrLib_StrEqual (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned int higha;
+ unsigned int highb;
+ char a[_a_high+1];
+ char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+
+ higha = _a_high;
+ highb = _b_high;
+ i = 0;
+ while ((((i <= higha) && (i <= highb)) && (a[i] != ASCII_nul)) && (b[i] != ASCII_nul))
+ {
+ if (a[i] != b[i])
+ {
+ return FALSE;
+ }
+ i += 1;
+ }
+ return ! (((i <= higha) && (a[i] != ASCII_nul)) || ((i <= highb) && (b[i] != ASCII_nul)));
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+extern "C" unsigned int StrLib_StrLen (const char *a_, unsigned int _a_high)
+{
+ unsigned int High;
+ unsigned int Len;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ Len = 0;
+ High = _a_high;
+ while ((Len <= High) && (a[Len] != ASCII_nul))
+ {
+ Len += 1;
+ }
+ return Len;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StrCopy - copy string src into string dest providing dest is large enough.
+ If dest is smaller than a then src then the string is truncated when
+ dest is full. Add a nul character if there is room in dest.
+*/
+
+extern "C" void StrLib_StrCopy (const char *src_, unsigned int _src_high, char *dest, unsigned int _dest_high)
+{
+ unsigned int HighSrc;
+ unsigned int HighDest;
+ unsigned int n;
+ char src[_src_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (src, src_, _src_high+1);
+
+ n = 0;
+ HighSrc = StrLib_StrLen ((const char *) src, _src_high);
+ HighDest = _dest_high;
+ while ((n < HighSrc) && (n <= HighDest))
+ {
+ dest[n] = src[n];
+ n += 1;
+ }
+ if (n <= HighDest)
+ {
+ dest[n] = ASCII_nul;
+ }
+}
+
+
+/*
+ IsSubString - returns true if b is a subcomponent of a.
+*/
+
+extern "C" unsigned int StrLib_IsSubString (const char *a_, unsigned int _a_high, const char *b_, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned int j;
+ unsigned int LengthA;
+ unsigned int LengthB;
+ char a[_a_high+1];
+ char b[_b_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+ memcpy (b, b_, _b_high+1);
+
+ LengthA = StrLib_StrLen ((const char *) a, _a_high);
+ LengthB = StrLib_StrLen ((const char *) b, _b_high);
+ i = 0;
+ if (LengthA > LengthB)
+ {
+ while (i <= (LengthA-LengthB))
+ {
+ j = 0;
+ while ((j < LengthB) && (a[i+j] == b[j]))
+ {
+ j += 1;
+ }
+ if (j == LengthB)
+ {
+ return TRUE;
+ }
+ else
+ {
+ i += 1;
+ }
+ }
+ }
+ return FALSE;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StrRemoveWhitePrefix - copies string, into string, b, excluding any white
+ space infront of a.
+*/
+
+extern "C" void StrLib_StrRemoveWhitePrefix (const char *a_, unsigned int _a_high, char *b, unsigned int _b_high)
+{
+ unsigned int i;
+ unsigned int j;
+ unsigned int higha;
+ unsigned int highb;
+ char a[_a_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (a, a_, _a_high+1);
+
+ i = 0;
+ j = 0;
+ higha = StrLib_StrLen ((const char *) a, _a_high);
+ highb = _b_high;
+ while ((i < higha) && (IsWhite (a[i])))
+ {
+ i += 1;
+ }
+ while ((i < higha) && (j <= highb))
+ {
+ b[j] = a[i];
+ i += 1;
+ j += 1;
+ }
+ if (j <= highb)
+ {
+ b[j] = ASCII_nul;
+ }
+}
+
+extern "C" void _M2_StrLib_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
+
+extern "C" void _M2_StrLib_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+{
+}
diff --git a/gcc/m2/mc-boot/GStringConvert.cc b/gcc/m2/mc-boot/GStringConvert.cc
new file mode 100644
index 00000000000..faa5e34459e
--- /dev/null
+++ b/gcc/m2/mc-boot/GStringConvert.cc
@@ -0,0 +1,2005 @@
+/* do not edit automatically generated by mc from StringConvert. */
+/* StringConvert.mod provides functions to convert numbers to and from strings.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+# if !defined (PROC_D)
+# define PROC_D
+ typedef void (*PROC_t) (void);
+ typedef struct { PROC_t proc; } PROC;
+# endif
+
+# if !defined (TRUE)
+# define TRUE (1==1)
+# endif
+
+# if !defined (FALSE)
+# define FALSE (1==0)
+# endif
+
+#if defined(__cplusplus)
+# undef NULL
+# define NULL 0
+#endif
+#define _StringConvert_H
+#define _StringConvert_C
+
+# include "GSYSTEM.h"
+# include "Glibc.h"
+# include "Glibm.h"
+# include "GM2RTS.h"
+# include "GDynamicStrings.h"
+# include "Gldtoa.h"
+# include "Gdtoa.h"
+
+
+/*
+ IntegerToString - converts INTEGER, i, into a String. The field with can be specified
+ if non zero. Leading characters are defined by padding and this
+ function will prepend a + if sign is set to TRUE.
+ The base allows the caller to generate binary, octal, decimal, hexidecimal
+ numbers. The value of lower is only used when hexidecimal numbers are
+ generated and if TRUE then digits abcdef are used, and if FALSE then ABCDEF
+ are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_IntegerToString (int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower);
+
+/*
+ CardinalToString - converts CARDINAL, c, into a String. The field with can be specified
+ if non zero. Leading characters are defined by padding.
+ The base allows the caller to generate binary, octal, decimal, hexidecimal
+ numbers. The value of lower is only used when hexidecimal numbers are
+ generated and if TRUE then digits abcdef are used, and if FALSE then ABCDEF
+ are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_CardinalToString (unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower);
+
+/*
+ StringToInteger - converts a string, s, of, base, into an INTEGER.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" int StringConvert_StringToInteger (DynamicStrings_String s, unsigned int base, unsigned int *found);
+
+/*
+ StringToCardinal - converts a string, s, of, base, into a CARDINAL.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" unsigned int StringConvert_StringToCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found);
+
+/*
+ LongIntegerToString - converts LONGINT, i, into a String. The field with
+ can be specified if non zero. Leading characters
+ are defined by padding and this function will
+ prepend a + if sign is set to TRUE.
+ The base allows the caller to generate binary,
+ octal, decimal, hexidecimal numbers.
+ The value of lower is only used when hexidecimal
+ numbers are generated and if TRUE then digits
+ abcdef are used, and if FALSE then ABCDEF are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_LongIntegerToString (long int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower);
+
+/*
+ StringToLongInteger - converts a string, s, of, base, into an LONGINT.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" long int StringConvert_StringToLongInteger (DynamicStrings_String s, unsigned int base, unsigned int *found);
+
+/*
+ LongCardinalToString - converts LONGCARD, c, into a String. The field
+ width can be specified if non zero. Leading
+ characters are defined by padding.
+ The base allows the caller to generate binary,
+ octal, decimal, hexidecimal numbers.
+ The value of lower is only used when hexidecimal
+ numbers are generated and if TRUE then digits
+ abcdef are used, and if FALSE then ABCDEF are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_LongCardinalToString (long unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower);
+
+/*
+ StringToLongCardinal - converts a string, s, of, base, into a LONGCARD.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" long unsigned int StringConvert_StringToLongCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found);
+
+/*
+ ShortCardinalToString - converts SHORTCARD, c, into a String. The field
+ width can be specified if non zero. Leading
+ characters are defined by padding.
+ The base allows the caller to generate binary,
+ octal, decimal, hexidecimal numbers.
+ The value of lower is only used when hexidecimal
+ numbers are generated and if TRUE then digits
+ abcdef are used, and if FALSE then ABCDEF are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_ShortCardinalToString (short unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower);
+
+/*
+ StringToShortCardinal - converts a string, s, of, base, into a SHORTCARD.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" short unsigned int StringConvert_StringToShortCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found);
+
+/*
+ stoi - decimal string to INTEGER
+*/
+
+extern "C" int StringConvert_stoi (DynamicStrings_String s);
+
+/*
+ itos - integer to decimal string.
+*/
+
+extern "C" DynamicStrings_String StringConvert_itos (int i, unsigned int width, char padding, unsigned int sign);
+
+/*
+ ctos - cardinal to decimal string.
+*/
+
+extern "C" DynamicStrings_String StringConvert_ctos (unsigned int c, unsigned int width, char padding);
+
+/*
+ stoc - decimal string to CARDINAL
+*/
+
+extern "C" unsigned int StringConvert_stoc (DynamicStrings_String s);
+
+/*
+ hstoi - hexidecimal string to INTEGER
+*/
+
+extern "C" int StringConvert_hstoi (DynamicStrings_String s);
+
+/*
+ ostoi - octal string to INTEGER
+*/
+
+extern "C" int StringConvert_ostoi (DynamicStrings_String s);
+
+/*
+ bstoi - binary string to INTEGER
+*/
+
+extern "C" int StringConvert_bstoi (DynamicStrings_String s);
+
+/*
+ hstoc - hexidecimal string to CARDINAL
+*/
+
+extern "C" unsigned int StringConvert_hstoc (DynamicStrings_String s);
+
+/*
+ ostoc - octal string to CARDINAL
+*/
+
+extern "C" unsigned int StringConvert_ostoc (DynamicStrings_String s);
+
+/*
+ bstoc - binary string to CARDINAL
+*/
+
+extern "C" unsigned int StringConvert_bstoc (DynamicStrings_String s);
+
+/*
+ StringToLongreal - returns a LONGREAL and sets found to TRUE if a legal number is seen.
+*/
+
+extern "C" long double StringConvert_StringToLongreal (DynamicStrings_String s, unsigned int *found);
+
+/*
+ LongrealToString - converts a LONGREAL number, Real, which has,
+ TotalWidth, and FractionWidth into a string.
+ It uses decimal notation.
+
+ So for example:
+
+ LongrealToString(1.0, 4, 2) -> '1.00'
+ LongrealToString(12.3, 5, 2) -> '12.30'
+ LongrealToString(12.3, 6, 2) -> ' 12.30'
+ LongrealToString(12.3, 6, 3) -> '12.300'
+
+ if total width is too small then the fraction
+ becomes truncated.
+
+ LongrealToString(12.3, 5, 3) -> '12.30'
+
+ Positive numbers do not have a '+' prepended.
+ Negative numbers will have a '-' prepended and
+ the TotalWidth will need to be large enough
+ to contain the sign, whole number, '.' and
+ fractional components.
+*/
+
+extern "C" DynamicStrings_String StringConvert_LongrealToString (long double x, unsigned int TotalWidth, unsigned int FractionWidth);
+
+/*
+ stor - returns a REAL given a string.
+*/
+
+extern "C" double StringConvert_stor (DynamicStrings_String s);
+
+/*
+ stolr - returns a LONGREAL given a string.
+*/
+
+extern "C" long double StringConvert_stolr (DynamicStrings_String s);
+
+/*
+ ToSigFig - returns a floating point or base 10 integer
+ string which is accurate to, n, significant
+ figures. It will return a new String
+ and, s, will be destroyed.
+
+
+ So: 12.345
+
+ rounded to the following significant figures yields
+
+ 5 12.345
+ 4 12.34
+ 3 12.3
+ 2 12
+ 1 10
+*/
+
+extern "C" DynamicStrings_String StringConvert_ToSigFig (DynamicStrings_String s, unsigned int n);
+
+/*
+ ToDecimalPlaces - returns a floating point or base 10 integer
+ string which is accurate to, n, decimal
+ places. It will return a new String
+ and, s, will be destroyed.
+ Decimal places yields, n, digits after
+ the .
+
+ So: 12.345
+
+ rounded to the following decimal places yields
+
+ 5 12.34500
+ 4 12.3450
+ 3 12.345
+ 2 12.34
+ 1 12.3
+*/
+
+extern "C" DynamicStrings_String StringConvert_ToDecimalPlaces (DynamicStrings_String s, unsigned int n);
+
+/*
+ Assert - implement a simple assert.
+*/
+
+static void Assert (unsigned int b, const char *file_, unsigned int _file_high, unsigned int line, const char *func_, unsigned int _func_high);
+
+/*
+ Max -
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b);
+
+/*
+ Min -
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b);
+
+/*
+ LongMin - returns the smallest LONGCARD
+*/
+
+static long unsigned int LongMin (long unsigned int a, long unsigned int b);
+
+/*
+ IsDigit - returns TRUE if, ch, lies between '0'..'9'.
+*/
+
+static unsigned int IsDigit (char ch);
+
+/*
+ IsDecimalDigitValid - returns the TRUE if, ch, is a base legal decimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsDecimalDigitValid (char ch, unsigned int base, unsigned int *c);
+
+/*
+ IsHexidecimalDigitValid - returns the TRUE if, ch, is a base legal hexidecimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsHexidecimalDigitValid (char ch, unsigned int base, unsigned int *c);
+
+/*
+ IsDecimalDigitValidLong - returns the TRUE if, ch, is a base legal decimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsDecimalDigitValidLong (char ch, unsigned int base, long unsigned int *c);
+
+/*
+ IsHexidecimalDigitValidLong - returns the TRUE if, ch, is a base legal hexidecimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsHexidecimalDigitValidLong (char ch, unsigned int base, long unsigned int *c);
+
+/*
+ IsDecimalDigitValidShort - returns the TRUE if, ch, is a base legal decimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsDecimalDigitValidShort (char ch, unsigned int base, short unsigned int *c);
+
+/*
+ IsHexidecimalDigitValidShort - returns the TRUE if, ch, is a base legal hexidecimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsHexidecimalDigitValidShort (char ch, unsigned int base, short unsigned int *c);
+
+/*
+ ToThePower10 - returns a LONGREAL containing the value of v * 10^power.
+*/
+
+static long double ToThePower10 (long double v, int power);
+
+/*
+ DetermineSafeTruncation - we wish to use TRUNC when converting REAL/LONGREAL
+ into a string for the non fractional component.
+ However we need a simple method to
+ determine the maximum safe truncation value.
+*/
+
+static unsigned int DetermineSafeTruncation (void);
+
+/*
+ rtos -
+*/
+
+static DynamicStrings_String rtos (double r, unsigned int TotalWidth, unsigned int FractionWidth);
+
+/*
+ lrtos -
+*/
+
+static DynamicStrings_String lrtos (long double r, unsigned int TotalWidth, unsigned int FractionWidth);
+
+/*
+ doDecimalPlaces - returns a string which is accurate to
+ n decimal places. It returns a new String
+ and, s, will be destroyed.
+*/
+
+static DynamicStrings_String doDecimalPlaces (DynamicStrings_String s, unsigned int n);
+
+/*
+ doSigFig - returns a string which is accurate to
+ n decimal places. It returns a new String
+ and, s, will be destroyed.
+*/
+
+static DynamicStrings_String doSigFig (DynamicStrings_String s, unsigned int n);
+
+/*
+ carryOne - add a carry at position, i.
+*/
+
+static DynamicStrings_String carryOne (DynamicStrings_String s, unsigned int i);
+
+
+/*
+ Assert - implement a simple assert.
+*/
+
+static void Assert (unsigned int b, const char *file_, unsigned int _file_high, unsigned int line, const char *func_, unsigned int _func_high)
+{
+ char file[_file_high+1];
+ char func[_func_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (file, file_, _file_high+1);
+ memcpy (func, func_, _func_high+1);
+
+ if (! b)
+ {
+ M2RTS_ErrorMessage ((const char *) "assert failed", 13, (const char *) file, _file_high, line, (const char *) func, _func_high);
+ }
+}
+
+
+/*
+ Max -
+*/
+
+static unsigned int Max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ Min -
+*/
+
+static unsigned int Min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LongMin - returns the smallest LONGCARD
+*/
+
+static long unsigned int LongMin (long unsigned int a, long unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsDigit - returns TRUE if, ch, lies between '0'..'9'.
+*/
+
+static unsigned int IsDigit (char ch)
+{
+ return (ch >= '0') && (ch <= '9');
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsDecimalDigitValid - returns the TRUE if, ch, is a base legal decimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsDecimalDigitValid (char ch, unsigned int base, unsigned int *c)
+{
+ if ((IsDigit (ch)) && (( ((unsigned int) (ch))- ((unsigned int) ('0'))) < base))
+ {
+ (*c) = ((*c)*base)+( ((unsigned int) (ch))- ((unsigned int) ('0')));
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsHexidecimalDigitValid - returns the TRUE if, ch, is a base legal hexidecimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsHexidecimalDigitValid (char ch, unsigned int base, unsigned int *c)
+{
+ if (((ch >= 'a') && (ch <= 'f')) && ((( ((unsigned int) (ch))- ((unsigned int) ('a')))+10) < base))
+ {
+ (*c) = ((*c)*base)+(( ((unsigned int) (ch))- ((unsigned int) ('a')))+10);
+ return TRUE;
+ }
+ else if (((ch >= 'A') && (ch <= 'F')) && ((( ((unsigned int) (ch))- ((unsigned int) ('F')))+10) < base))
+ {
+ /* avoid dangling else. */
+ (*c) = ((*c)*base)+(( ((unsigned int) (ch))- ((unsigned int) ('A')))+10);
+ return TRUE;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsDecimalDigitValidLong - returns the TRUE if, ch, is a base legal decimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsDecimalDigitValidLong (char ch, unsigned int base, long unsigned int *c)
+{
+ if ((IsDigit (ch)) && (( ((unsigned int) (ch))- ((unsigned int) ('0'))) < base))
+ {
+ (*c) = (*c)*((long unsigned int ) (base+( ((unsigned int) (ch))- ((unsigned int) ('0')))));
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsHexidecimalDigitValidLong - returns the TRUE if, ch, is a base legal hexidecimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsHexidecimalDigitValidLong (char ch, unsigned int base, long unsigned int *c)
+{
+ if (((ch >= 'a') && (ch <= 'f')) && ((( ((unsigned int) (ch))- ((unsigned int) ('a')))+10) < base))
+ {
+ (*c) = (*c)*((long unsigned int ) (base+(( ((unsigned int) (ch))- ((unsigned int) ('a')))+10)));
+ return TRUE;
+ }
+ else if (((ch >= 'A') && (ch <= 'F')) && ((( ((unsigned int) (ch))- ((unsigned int) ('F')))+10) < base))
+ {
+ /* avoid dangling else. */
+ (*c) = (*c)*((long unsigned int ) (base+(( ((unsigned int) (ch))- ((unsigned int) ('A')))+10)));
+ return TRUE;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsDecimalDigitValidShort - returns the TRUE if, ch, is a base legal decimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsDecimalDigitValidShort (char ch, unsigned int base, short unsigned int *c)
+{
+ if ((IsDigit (ch)) && (( ((unsigned int) (ch))- ((unsigned int) ('0'))) < base))
+ {
+ (*c) = (*c)*((short unsigned int ) (base+( ((unsigned int) (ch))- ((unsigned int) ('0')))));
+ return TRUE;
+ }
+ else
+ {
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IsHexidecimalDigitValidShort - returns the TRUE if, ch, is a base legal hexidecimal digit.
+ If legal then the value is appended numerically onto, c.
+*/
+
+static unsigned int IsHexidecimalDigitValidShort (char ch, unsigned int base, short unsigned int *c)
+{
+ if (((ch >= 'a') && (ch <= 'f')) && ((( ((unsigned int) (ch))- ((unsigned int) ('a')))+10) < base))
+ {
+ (*c) = (*c)*((short unsigned int ) (base+(( ((unsigned int) (ch))- ((unsigned int) ('a')))+10)));
+ return TRUE;
+ }
+ else if (((ch >= 'A') && (ch <= 'F')) && ((( ((unsigned int) (ch))- ((unsigned int) ('F')))+10) < base))
+ {
+ /* avoid dangling else. */
+ (*c) = (*c)*((short unsigned int ) (base+(( ((unsigned int) (ch))- ((unsigned int) ('A')))+10)));
+ return TRUE;
+ }
+ else
+ {
+ /* avoid dangling else. */
+ return FALSE;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ ToThePower10 - returns a LONGREAL containing the value of v * 10^power.
+*/
+
+static long double ToThePower10 (long double v, int power)
+{
+ int i;
+
+ i = 0;
+ if (power > 0)
+ {
+ while (i < power)
+ {
+ v = v*10.0;
+ i += 1;
+ }
+ }
+ else
+ {
+ while (i > power)
+ {
+ v = v/10.0;
+ i -= 1;
+ }
+ }
+ return v;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ DetermineSafeTruncation - we wish to use TRUNC when converting REAL/LONGREAL
+ into a string for the non fractional component.
+ However we need a simple method to
+ determine the maximum safe truncation value.
+*/
+
+static unsigned int DetermineSafeTruncation (void)
+{
+ double MaxPowerOfTen;
+ unsigned int LogPower;
+
+ MaxPowerOfTen = static_cast<double> (1.0);
+ LogPower = 0;
+ while ((MaxPowerOfTen*10.0) < ((double) ((INT_MAX) / 10)))
+ {
+ MaxPowerOfTen = MaxPowerOfTen*10.0;
+ LogPower += 1;
+ }
+ return LogPower;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ rtos -
+*/
+
+static DynamicStrings_String rtos (double r, unsigned int TotalWidth, unsigned int FractionWidth)
+{
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ return static_cast<DynamicStrings_String> (NULL);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ lrtos -
+*/
+
+static DynamicStrings_String lrtos (long double r, unsigned int TotalWidth, unsigned int FractionWidth)
+{
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
+ return static_cast<DynamicStrings_String> (NULL);
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doDecimalPlaces - returns a string which is accurate to
+ n decimal places. It returns a new String
+ and, s, will be destroyed.
+*/
+
+static DynamicStrings_String doDecimalPlaces (DynamicStrings_String s, unsigned int n)
+{
+ int i;
+ int l;
+ int point;
+ DynamicStrings_String t;
+ DynamicStrings_String whole;
+ DynamicStrings_String fraction;
+ DynamicStrings_String tenths;
+ DynamicStrings_String hundreths;
+
+ l = DynamicStrings_Length (s);
+ i = 0;
+ /* remove '.' */
+ point = DynamicStrings_Index (s, '.', 0);
+ if (point == 0)
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 1, 0);
+ }
+ else if (point < l)
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_ConCat (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point+1, 0)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point);
+ }
+ l = DynamicStrings_Length (s);
+ i = 0;
+ if (l > 0)
+ {
+ /* skip over leading zeros */
+ while ((i < l) && ((DynamicStrings_char (s, i)) == '0'))
+ {
+ i += 1;
+ }
+ /* was the string full of zeros? */
+ if ((i == l) && ((DynamicStrings_char (s, i-1)) == '0'))
+ {
+ s = DynamicStrings_KillString (s);
+ s = DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "0.", 2), DynamicStrings_Mark (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), n)));
+ return s;
+ }
+ }
+ /* insert leading zero */
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('0'), DynamicStrings_Mark (s));
+ point += 1; /* and move point position to correct place */
+ l = DynamicStrings_Length (s); /* update new length */
+ i = point; /* update new length */
+ while ((n > 1) && (i < l))
+ {
+ n -= 1;
+ i += 1;
+ }
+ if ((i+3) <= l)
+ {
+ t = DynamicStrings_Dup (s);
+ hundreths = DynamicStrings_Slice (DynamicStrings_Mark (s), i+1, i+3);
+ s = t;
+ if ((StringConvert_stoc (hundreths)) >= 50)
+ {
+ s = carryOne (DynamicStrings_Mark (s), static_cast<unsigned int> (i));
+ }
+ hundreths = DynamicStrings_KillString (hundreths);
+ }
+ else if ((i+2) <= l)
+ {
+ /* avoid dangling else. */
+ t = DynamicStrings_Dup (s);
+ tenths = DynamicStrings_Slice (DynamicStrings_Mark (s), i+1, i+2);
+ s = t;
+ if ((StringConvert_stoc (tenths)) >= 5)
+ {
+ s = carryOne (DynamicStrings_Mark (s), static_cast<unsigned int> (i));
+ }
+ tenths = DynamicStrings_KillString (tenths);
+ }
+ /* check whether we need to remove the leading zero */
+ if ((DynamicStrings_char (s, 0)) == '0')
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 1, 0);
+ l -= 1;
+ point -= 1;
+ }
+ if (i < l)
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i);
+ l = DynamicStrings_Length (s);
+ if (l < point)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), static_cast<unsigned int> (point-l)));
+ }
+ }
+ /* re-insert the point */
+ if (point >= 0)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (point == 0)
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('.'), DynamicStrings_Mark (s));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), '.'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point, 0)));
+ }
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ doSigFig - returns a string which is accurate to
+ n decimal places. It returns a new String
+ and, s, will be destroyed.
+*/
+
+static DynamicStrings_String doSigFig (DynamicStrings_String s, unsigned int n)
+{
+ int i;
+ int l;
+ int z;
+ int point;
+ DynamicStrings_String t;
+ DynamicStrings_String tenths;
+ DynamicStrings_String hundreths;
+
+ l = DynamicStrings_Length (s);
+ i = 0;
+ /* remove '.' */
+ point = DynamicStrings_Index (s, '.', 0);
+ if (point >= 0)
+ {
+ if (point == 0)
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 1, 0);
+ }
+ else if (point < l)
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_ConCat (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point+1, 0)));
+ }
+ else
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point);
+ }
+ }
+ else
+ {
+ s = DynamicStrings_Dup (DynamicStrings_Mark (s));
+ }
+ l = DynamicStrings_Length (s);
+ i = 0;
+ if (l > 0)
+ {
+ /* skip over leading zeros */
+ while ((i < l) && ((DynamicStrings_char (s, i)) == '0'))
+ {
+ i += 1;
+ }
+ /* was the string full of zeros? */
+ if ((i == l) && ((DynamicStrings_char (s, i-1)) == '0'))
+ {
+ /* truncate string */
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, static_cast<int> (n));
+ i = n;
+ }
+ }
+ /* add a leading zero in case we need to overflow the carry */
+ z = i; /* remember where we inserted zero */
+ if (z == 0) /* remember where we inserted zero */
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('0'), DynamicStrings_Mark (s));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i), '0'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), i, 0)));
+ }
+ n += 1; /* and increase the number of sig figs needed */
+ l = DynamicStrings_Length (s); /* and increase the number of sig figs needed */
+ while ((n > 1) && (i < l))
+ {
+ n -= 1;
+ i += 1;
+ }
+ if ((i+3) <= l)
+ {
+ t = DynamicStrings_Dup (s);
+ hundreths = DynamicStrings_Slice (DynamicStrings_Mark (s), i+1, i+3);
+ s = t;
+ if ((StringConvert_stoc (hundreths)) >= 50)
+ {
+ s = carryOne (DynamicStrings_Mark (s), static_cast<unsigned int> (i));
+ }
+ hundreths = DynamicStrings_KillString (hundreths);
+ }
+ else if ((i+2) <= l)
+ {
+ /* avoid dangling else. */
+ t = DynamicStrings_Dup (s);
+ tenths = DynamicStrings_Slice (DynamicStrings_Mark (s), i+1, i+2);
+ s = t;
+ if ((StringConvert_stoc (tenths)) >= 5)
+ {
+ s = carryOne (DynamicStrings_Mark (s), static_cast<unsigned int> (i));
+ }
+ tenths = DynamicStrings_KillString (tenths);
+ }
+ /* check whether we need to remove the leading zero */
+ if ((DynamicStrings_char (s, z)) == '0')
+ {
+ if (z == 0)
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), z+1, 0);
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, z), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), z+1, 0)));
+ }
+ l = DynamicStrings_Length (s);
+ }
+ else
+ {
+ point += 1;
+ }
+ if (i < l)
+ {
+ s = DynamicStrings_Slice (DynamicStrings_Mark (s), 0, i);
+ l = DynamicStrings_Length (s);
+ if (l < point)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar ('0')), static_cast<unsigned int> (point-l)));
+ }
+ }
+ /* re-insert the point */
+ if (point >= 0)
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if (point == 0)
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('.'), DynamicStrings_Mark (s));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, point), '.'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), point, 0)));
+ }
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ carryOne - add a carry at position, i.
+*/
+
+static DynamicStrings_String carryOne (DynamicStrings_String s, unsigned int i)
+{
+ if (i >= 0)
+ {
+ if (IsDigit (DynamicStrings_char (s, static_cast<int> (i))))
+ {
+ /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ if ((DynamicStrings_char (s, static_cast<int> (i))) == '9')
+ {
+ if (i == 0)
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ('1'), DynamicStrings_Mark (s));
+ return s;
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, static_cast<int> (i)), '0'), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), static_cast<int> (i+1), 0)));
+ return carryOne (s, i-1);
+ }
+ }
+ else
+ {
+ if (i == 0)
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_InitStringChar ( ((char) ( ((unsigned int) (DynamicStrings_char (s, static_cast<int> (i))))+1))), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), static_cast<int> (i+1), 0)));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCatChar (DynamicStrings_Slice (DynamicStrings_Mark (s), 0, static_cast<int> (i)), ((char) ( ((unsigned int) (DynamicStrings_char (s, static_cast<int> (i))))+1))), DynamicStrings_Mark (DynamicStrings_Slice (DynamicStrings_Mark (s), static_cast<int> (i+1), 0)));
+ }
+ }
+ }
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ IntegerToString - converts INTEGER, i, into a String. The field with can be specified
+ if non zero. Leading characters are defined by padding and this
+ function will prepend a + if sign is set to TRUE.
+ The base allows the caller to generate binary, octal, decimal, hexidecimal
+ numbers. The value of lower is only used when hexidecimal numbers are
+ generated and if TRUE then digits abcdef are used, and if FALSE then ABCDEF
+ are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_IntegerToString (int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower)
+{
+ DynamicStrings_String s;
+ unsigned int c;
+
+ if (i < 0)
+ {
+ if (i == (INT_MIN))
+ {
+ /* remember that -15 MOD 4 = 1 in Modula-2 */
+ c = ((unsigned int ) (abs (i+1)))+1;
+ if (width > 0)
+ {
+ return DynamicStrings_ConCat (StringConvert_IntegerToString (-((int ) (c / base)), width-1, padding, sign, base, lower), DynamicStrings_Mark (StringConvert_IntegerToString (static_cast<int> (c % base), 0, ' ', FALSE, base, lower)));
+ }
+ else
+ {
+ return DynamicStrings_ConCat (StringConvert_IntegerToString (-((int ) (c / base)), 0, padding, sign, base, lower), DynamicStrings_Mark (StringConvert_IntegerToString (static_cast<int> (c % base), 0, ' ', FALSE, base, lower)));
+ }
+ }
+ else
+ {
+ s = DynamicStrings_InitString ((const char *) "-", 1);
+ }
+ i = -i;
+ }
+ else
+ {
+ if (sign)
+ {
+ s = DynamicStrings_InitString ((const char *) "+", 1);
+ }
+ else
+ {
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ }
+ }
+ if (i > (((int ) (base))-1))
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, DynamicStrings_Mark (StringConvert_IntegerToString (static_cast<int> (((unsigned int ) (i)) / base), 0, ' ', FALSE, base, lower))), DynamicStrings_Mark (StringConvert_IntegerToString (static_cast<int> (((unsigned int ) (i)) % base), 0, ' ', FALSE, base, lower)));
+ }
+ else
+ {
+ if (i <= 9)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) (((unsigned int ) (i))+ ((unsigned int) ('0')))))));
+ }
+ else
+ {
+ if (lower)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (i))+ ((unsigned int) ('a')))-10)))));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (i))+ ((unsigned int) ('A')))-10)))));
+ }
+ }
+ }
+ if (width > (DynamicStrings_Length (s)))
+ {
+ return DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (padding)), width-(DynamicStrings_Length (s))), DynamicStrings_Mark (s));
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ CardinalToString - converts CARDINAL, c, into a String. The field with can be specified
+ if non zero. Leading characters are defined by padding.
+ The base allows the caller to generate binary, octal, decimal, hexidecimal
+ numbers. The value of lower is only used when hexidecimal numbers are
+ generated and if TRUE then digits abcdef are used, and if FALSE then ABCDEF
+ are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_CardinalToString (unsigned int c, unsigned int width, char padding, unsigned int base, unsigned int lower)
+{
+ DynamicStrings_String s;
+
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ if (c > (base-1))
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, DynamicStrings_Mark (StringConvert_CardinalToString (c / base, 0, ' ', base, lower))), DynamicStrings_Mark (StringConvert_CardinalToString (c % base, 0, ' ', base, lower)));
+ }
+ else
+ {
+ if (c <= 9)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) (c+ ((unsigned int) ('0')))))));
+ }
+ else
+ {
+ if (lower)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((c+ ((unsigned int) ('a')))-10)))));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((c+ ((unsigned int) ('A')))-10)))));
+ }
+ }
+ }
+ if (width > (DynamicStrings_Length (s)))
+ {
+ return DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (padding)), width-(DynamicStrings_Length (s))), s);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StringToInteger - converts a string, s, of, base, into an INTEGER.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" int StringConvert_StringToInteger (DynamicStrings_String s, unsigned int base, unsigned int *found)
+{
+ unsigned int n;
+ unsigned int l;
+ unsigned int c;
+ unsigned int negative;
+
+ s = DynamicStrings_RemoveWhitePrefix (s); /* returns a new string, s */
+ l = DynamicStrings_Length (s); /* returns a new string, s */
+ c = 0;
+ n = 0;
+ negative = FALSE;
+ if (n < l)
+ {
+ /* parse leading + and - */
+ while (((DynamicStrings_char (s, static_cast<int> (n))) == '-') || ((DynamicStrings_char (s, static_cast<int> (n))) == '+'))
+ {
+ if ((DynamicStrings_char (s, static_cast<int> (n))) == '-')
+ {
+ negative = ! negative;
+ }
+ n += 1;
+ }
+ while ((n < l) && ((IsDecimalDigitValid (DynamicStrings_char (s, static_cast<int> (n)), base, &c)) || (IsHexidecimalDigitValid (DynamicStrings_char (s, static_cast<int> (n)), base, &c))))
+ {
+ (*found) = TRUE;
+ n += 1;
+ }
+ }
+ s = DynamicStrings_KillString (s);
+ if (negative)
+ {
+ return -((int ) (Min (((unsigned int ) (INT_MAX))+1, c)));
+ }
+ else
+ {
+ return (int ) (Min (static_cast<unsigned int> (INT_MAX), c));
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StringToCardinal - converts a string, s, of, base, into a CARDINAL.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" unsigned int StringConvert_StringToCardinal (DynamicStrings_String s, unsigned int base, unsigned int *found)
+{
+ unsigned int n;
+ unsigned int l;
+ unsigned int c;
+
+ s = DynamicStrings_RemoveWhitePrefix (s); /* returns a new string, s */
+ l = DynamicStrings_Length (s); /* returns a new string, s */
+ c = 0;
+ n = 0;
+ if (n < l)
+ {
+ /* parse leading + */
+ while ((DynamicStrings_char (s, static_cast<int> (n))) == '+')
+ {
+ n += 1;
+ }
+ while ((n < l) && ((IsDecimalDigitValid (DynamicStrings_char (s, static_cast<int> (n)), base, &c)) || (IsHexidecimalDigitValid (DynamicStrings_char (s, static_cast<int> (n)), base, &c))))
+ {
+ (*found) = TRUE;
+ n += 1;
+ }
+ }
+ s = DynamicStrings_KillString (s);
+ return c;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LongIntegerToString - converts LONGINT, i, into a String. The field with
+ can be specified if non zero. Leading characters
+ are defined by padding and this function will
+ prepend a + if sign is set to TRUE.
+ The base allows the caller to generate binary,
+ octal, decimal, hexidecimal numbers.
+ The value of lower is only used when hexidecimal
+ numbers are generated and if TRUE then digits
+ abcdef are used, and if FALSE then ABCDEF are used.
+*/
+
+extern "C" DynamicStrings_String StringConvert_LongIntegerToString (long int i, unsigned int width, char padding, unsigned int sign, unsigned int base, unsigned int lower)
+{
+ DynamicStrings_String s;
+ long unsigned int c;
+
+ if (i < 0)
+ {
+ if (i == (LONG_MIN))
+ {
+ /* remember that -15 MOD 4 is 1 in Modula-2, and although ABS(MIN(LONGINT)+1)
+ is very likely MAX(LONGINT), it is safer not to assume this is the case */
+ c = ((long unsigned int ) (labs (i+1)))+1;
+ if (width > 0)
+ {
+ return DynamicStrings_ConCat (StringConvert_LongIntegerToString (-((long int ) (c / ((long unsigned int ) (base)))), width-1, padding, sign, base, lower), DynamicStrings_Mark (StringConvert_LongIntegerToString (static_cast<long int> (c % ((long unsigned int ) (base))), 0, ' ', FALSE, base, lower)));
+ }
+ else
+ {
+ return DynamicStrings_ConCat (StringConvert_LongIntegerToString (-((long int ) (c / ((long unsigned int ) (base)))), 0, padding, sign, base, lower), DynamicStrings_Mark (StringConvert_LongIntegerToString (static_cast<long int> (c % ((long unsigned int ) (base))), 0, ' ', FALSE, base, lower)));
+ }
+ }
+ else
+ {
+ s = DynamicStrings_InitString ((const char *) "-", 1);
+ }
+ i = -i;
+ }
+ else
+ {
+ if (sign)
+ {
+ s = DynamicStrings_InitString ((const char *) "+", 1);
+ }
+ else
+ {
+ s = DynamicStrings_InitString ((const char *) "", 0);
+ }
+ }
+ if (i > ((long int ) (base-1)))
+ {
+ s = DynamicStrings_ConCat (DynamicStrings_ConCat (s, DynamicStrings_Mark (StringConvert_LongIntegerToString (i / ((long int ) (base)), 0, ' ', FALSE, base, lower))), DynamicStrings_Mark (StringConvert_LongIntegerToString (i % ((long int ) (base)), 0, ' ', FALSE, base, lower)));
+ }
+ else
+ {
+ if (i <= 9)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) (((unsigned int ) (i))+ ((unsigned int) ('0')))))));
+ }
+ else
+ {
+ if (lower)
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (i))+ ((unsigned int) ('a')))-10)))));
+ }
+ else
+ {
+ s = DynamicStrings_ConCat (s, DynamicStrings_Mark (DynamicStrings_InitStringChar ( ((char) ((((unsigned int ) (i))+ ((unsigned int) ('A')))-10)))));
+ }
+ }
+ }
+ if (width > (DynamicStrings_Length (s)))
+ {
+ return DynamicStrings_ConCat (DynamicStrings_Mult (DynamicStrings_Mark (DynamicStrings_InitStringChar (padding)), width-(DynamicStrings_Length (s))), s);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ StringToLongInteger - converts a string, s, of, base, into an LONGINT.
+ Leading white space is ignored. It stops converting
+ when either the string is exhausted or if an illegal
+ numeral is found.
+ The parameter found is set TRUE if a number was found.
+*/
+
+extern "C" long int StringConvert_StringToLongInteger (DynamicStrings_String s, unsigned int base, unsigned int *found)
+{
+ unsigned int n;
+ unsigned int l;
+ long unsigned int c;
+ unsigned int negative;
+
+ s = DynamicStrings_RemoveWhitePrefix (s); /* returns a new string, s */
+ l = DynamicStrings_Length (s); /* returns a new string, s */
+ c = 0;
+ n = 0;[...]
[diff truncated at 524288 bytes]
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-03-04 13:11 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-03-04 13:11 [gcc r13-6480] Fix modula-2 rename autogenerated .c files to .cc Gaius Mulley
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).